(git:5e7fe52)
Loading...
Searching...
No Matches
colvar_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 defines collective variables s({R}) and the derivative of this variable wrt R
10!> these can then be used in constraints, restraints and metadynamics ...
11!> \par History
12!> 04.2004 created
13!> 01.2006 Refactored [Joost VandeVondele]
14!> \author Alessandro Laio,Fawzi Mohamed
15! **************************************************************************************************
16MODULE colvar_methods
17
18 USE cell_types, ONLY: cell_transform_input_cartesian,&
19 cell_type,&
20 pbc
21 USE colvar_types, ONLY: &
22 hbp_colvar_id, wc_colvar_id, acid_hyd_dist_colvar_id, acid_hyd_shell_colvar_id, &
23 angle_colvar_id, colvar_create, colvar_setup, colvar_type, combine_colvar_id, &
24 coord_colvar_id, dfunct_colvar_id, dist_colvar_id, distance_from_path_colvar_id, &
25 do_clv_fix_point, do_clv_geo_center, do_clv_x, do_clv_xy, do_clv_xz, do_clv_y, do_clv_yz, &
26 do_clv_z, eval_point_der, eval_point_mass, eval_point_pos, gyration_colvar_id, &
27 hydronium_dist_colvar_id, hydronium_shell_colvar_id, mindist_colvar_id, plane_def_atoms, &
28 plane_def_vec, plane_distance_colvar_id, plane_plane_angle_colvar_id, &
29 population_colvar_id, qparm_colvar_id, reaction_path_colvar_id, ring_puckering_colvar_id, &
30 rmsd_colvar_id, rotation_colvar_id, torsion_colvar_id, u_colvar_id, voronoiipz_colvar_id, &
31 xyz_diag_colvar_id, xyz_outerdiag_colvar_id
32 USE constraint_fxd, ONLY: check_fixed_atom_cns_colv
33 USE cp_log_handling, ONLY: cp_get_default_logger,&
34 cp_logger_get_default_io_unit,&
35 cp_logger_type,&
36 cp_to_string
37 USE cp_output_handling, ONLY: cp_print_key_finished_output,&
38 cp_print_key_unit_nr
39 USE cp_parser_methods, ONLY: parser_get_next_line,&
40 parser_get_object
41 USE cp_parser_types, ONLY: cp_parser_type,&
42 parser_create,&
43 parser_release
44 USE cp_subsys_types, ONLY: cp_subsys_get,&
45 cp_subsys_p_type,&
46 cp_subsys_type
47 USE cp_units, ONLY: cp_unit_to_cp2k
48 USE force_env_types, ONLY: force_env_get,&
49 force_env_type,&
50 use_mixed_force
51 USE force_fields_util, ONLY: get_generic_info
52 USE fparser, ONLY: evalerrtype,&
53 evalf,&
54 evalfd,&
55 finalizef,&
56 initf,&
57 parsef
58 USE input_constants, ONLY: rmsd_all,&
59 rmsd_list,&
60 rmsd_weightlist
61 USE input_cp2k_colvar, ONLY: create_colvar_xyz_d_section,&
62 create_colvar_xyz_od_section
63 USE input_enumeration_types, ONLY: enum_i2c,&
64 enumeration_type
65 USE input_keyword_types, ONLY: keyword_get,&
66 keyword_type
67 USE input_section_types, ONLY: section_get_keyword,&
68 section_release,&
69 section_type,&
70 section_vals_get,&
71 section_vals_get_subs_vals,&
72 section_vals_type,&
73 section_vals_val_get
74 USE kahan_sum, ONLY: accurate_sum
75 USE kinds, ONLY: default_path_length,&
76 default_string_length,&
77 dp
78 USE mathconstants, ONLY: fac,&
79 maxfac,&
80 pi,&
81 twopi
82 USE mathlib, ONLY: vector_product
83 USE memory_utilities, ONLY: reallocate
84 USE message_passing, ONLY: mp_para_env_type
85 USE mixed_energy_types, ONLY: mixed_force_type
86 USE mixed_environment_utils, ONLY: get_subsys_map_index
87 USE molecule_kind_types, ONLY: fixd_constraint_type
88 USE particle_list_types, ONLY: particle_list_p_type,&
89 particle_list_type
90 USE particle_types, ONLY: particle_type
91 USE qs_environment_types, ONLY: get_qs_env,&
92 qs_environment_type
93 USE rmsd, ONLY: rmsd3
94 USE spherical_harmonics, ONLY: dlegendre,&
95 legendre
96 USE string_utilities, ONLY: compress,&
97 uppercase
98 USE wannier_states_types, ONLY: wannier_centres_type
99#include "./base/base_uses.f90"
100
101 IMPLICIT NONE
102 PRIVATE
103
104 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'colvar_methods'
105 REAL(KIND=dp), PRIVATE, PARAMETER :: tolerance_acos = 1.0e-5_dp
106
107 PUBLIC :: colvar_read, &
108 colvar_eval_glob_f, &
109 colvar_eval_mol_f
110
111CONTAINS
112
113! **************************************************************************************************
114!> \brief reads a colvar from the input
115!> \param colvar the place where to store what will be read
116!> \param icol number of the current colvar (repetition in colvar_section)
117!> \param colvar_section the colvar section
118!> \param para_env ...
119!> \param cell ...
120!> \par History
121!> 04.2004 created [alessandro laio and fawzi mohamed]
122!> \author teo
123! **************************************************************************************************
124 RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env, cell)
125 TYPE(colvar_type), POINTER :: colvar
126 INTEGER, INTENT(IN) :: icol
127 TYPE(section_vals_type), POINTER :: colvar_section
128 TYPE(mp_para_env_type), POINTER :: para_env
129 TYPE(cell_type), OPTIONAL, POINTER :: cell
130
131 CHARACTER(len=*), PARAMETER :: routinen = 'colvar_read'
132
133 CHARACTER(LEN=3) :: fmid
134 CHARACTER(LEN=7) :: tag, tag_comp, tag_comp1, tag_comp2
135 CHARACTER(LEN=default_path_length) :: path_function
136 CHARACTER(LEN=default_string_length) :: tmpstr, tmpstr2
137 CHARACTER(LEN=default_string_length), &
138 DIMENSION(:), POINTER :: c_kinds, my_par
139 INTEGER :: handle, i, iatm, icomponent, iend, &
140 ifunc, ii, isize, istart, iw, iw1, j, &
141 k, kk, n_var, n_var_k, ncol, ndim, &
142 nr_frame, v_count
143 INTEGER, DIMENSION(:), POINTER :: iatms
144 INTEGER, DIMENSION(:, :), POINTER :: p_bounds
145 LOGICAL :: check, use_mixed_energy
146 LOGICAL, DIMENSION(27) :: my_subsection
147 REAL(dp), DIMENSION(:), POINTER :: s1, wei, weights
148 REAL(dp), DIMENSION(:, :), POINTER :: p_range, s1v
149 REAL(kind=dp), DIMENSION(1) :: my_val
150 REAL(kind=dp), DIMENSION(:), POINTER :: g_range, grid_point, grid_sp, my_vals, &
151 range
152 TYPE(cp_logger_type), POINTER :: logger
153 TYPE(enumeration_type), POINTER :: enum
154 TYPE(keyword_type), POINTER :: keyword
155 TYPE(section_type), POINTER :: section
156 TYPE(section_vals_type), POINTER :: acid_hyd_dist_section, acid_hyd_shell_section, &
157 angle_section, colvar_subsection, combine_section, coordination_section, dfunct_section, &
158 distance_from_path_section, distance_section, frame_section, gyration_section, &
159 hbp_section, hydronium_dist_section, hydronium_shell_section, mindist_section, &
160 path_section, plane_dist_section, plane_plane_angle_section, plane_sections, &
161 point_section, population_section, qparm_section, reaction_path_section, &
162 ring_puckering_section, rmsd_section, rotation_section, torsion_section, u_section, &
163 voronoiipz_section, wc_section
164 TYPE(section_vals_type), POINTER :: wrk_section, xyz_diag_section, xyz_outerdiag_section
165
166 CALL timeset(routinen, handle)
167 NULLIFY (logger, c_kinds, iatms)
168 logger => cp_get_default_logger()
169 my_subsection = .false.
170 distance_section => section_vals_get_subs_vals(colvar_section, "DISTANCE", i_rep_section=icol)
171 dfunct_section => section_vals_get_subs_vals(colvar_section, "DISTANCE_FUNCTION", &
172 i_rep_section=icol)
173 angle_section => section_vals_get_subs_vals(colvar_section, "ANGLE", i_rep_section=icol)
174 torsion_section => section_vals_get_subs_vals(colvar_section, "TORSION", i_rep_section=icol)
175 coordination_section => section_vals_get_subs_vals(colvar_section, "COORDINATION", i_rep_section=icol)
176 plane_dist_section => section_vals_get_subs_vals(colvar_section, "DISTANCE_POINT_PLANE", i_rep_section=icol)
177 plane_plane_angle_section &
178 => section_vals_get_subs_vals(colvar_section, "ANGLE_PLANE_PLANE", i_rep_section=icol)
179 rotation_section => section_vals_get_subs_vals(colvar_section, "BOND_ROTATION", i_rep_section=icol)
180 qparm_section => section_vals_get_subs_vals(colvar_section, "QPARM", i_rep_section=icol)
181 hydronium_shell_section => section_vals_get_subs_vals(colvar_section, "HYDRONIUM_SHELL", i_rep_section=icol)
182 hydronium_dist_section => section_vals_get_subs_vals(colvar_section, "HYDRONIUM_DISTANCE", i_rep_section=icol)
183 acid_hyd_dist_section => section_vals_get_subs_vals(colvar_section, "ACID_HYDRONIUM_DISTANCE", i_rep_section=icol)
184 voronoiipz_section => section_vals_get_subs_vals(colvar_section, "VORONOIIPZ", i_rep_section=icol)
185
186 acid_hyd_shell_section &
187 => section_vals_get_subs_vals(colvar_section, "ACID_HYDRONIUM_SHELL", i_rep_section=icol)
188 reaction_path_section => section_vals_get_subs_vals(colvar_section, "REACTION_PATH", i_rep_section=icol, &
189 can_return_null=.true.)
190 distance_from_path_section &
191 => section_vals_get_subs_vals(colvar_section, "DISTANCE_FROM_PATH", &
192 i_rep_section=icol, can_return_null=.true.)
193 combine_section => section_vals_get_subs_vals(colvar_section, "COMBINE_COLVAR", i_rep_section=icol, &
194 can_return_null=.true.)
195 population_section => section_vals_get_subs_vals(colvar_section, "POPULATION", i_rep_section=icol)
196 gyration_section => section_vals_get_subs_vals(colvar_section, "GYRATION_RADIUS", i_rep_section=icol)
197 rmsd_section => section_vals_get_subs_vals(colvar_section, "RMSD", i_rep_section=icol)
198 xyz_diag_section => section_vals_get_subs_vals(colvar_section, "XYZ_DIAG", i_rep_section=icol)
199 xyz_outerdiag_section => section_vals_get_subs_vals(colvar_section, "XYZ_OUTERDIAG", i_rep_section=icol)
200 u_section => section_vals_get_subs_vals(colvar_section, "U", i_rep_section=icol)
201 wc_section => section_vals_get_subs_vals(colvar_section, "WC", i_rep_section=icol)
202 hbp_section => section_vals_get_subs_vals(colvar_section, "HBP", i_rep_section=icol)
203 ring_puckering_section &
204 => section_vals_get_subs_vals(colvar_section, "RING_PUCKERING", i_rep_section=icol)
205 mindist_section => section_vals_get_subs_vals(colvar_section, "CONDITIONED_DISTANCE", i_rep_section=icol)
206
207 CALL section_vals_get(distance_section, explicit=my_subsection(1))
208 CALL section_vals_get(angle_section, explicit=my_subsection(2))
209 CALL section_vals_get(torsion_section, explicit=my_subsection(3))
210 CALL section_vals_get(coordination_section, explicit=my_subsection(4))
211 CALL section_vals_get(plane_dist_section, explicit=my_subsection(5))
212 CALL section_vals_get(rotation_section, explicit=my_subsection(6))
213 CALL section_vals_get(dfunct_section, explicit=my_subsection(7))
214 CALL section_vals_get(qparm_section, explicit=my_subsection(8))
215 CALL section_vals_get(hydronium_shell_section, explicit=my_subsection(9))
216 ! These are just special cases since they are not present in their own defition of COLVARS
217 IF (ASSOCIATED(reaction_path_section)) THEN
218 CALL section_vals_get(reaction_path_section, &
219 explicit=my_subsection(10))
220 END IF
221 IF (ASSOCIATED(distance_from_path_section)) THEN
222 CALL section_vals_get(distance_from_path_section, &
223 explicit=my_subsection(16))
224 END IF
225 IF (ASSOCIATED(combine_section)) THEN
226 CALL section_vals_get(combine_section, explicit=my_subsection(11))
227 END IF
228 CALL section_vals_get(population_section, explicit=my_subsection(12))
229 CALL section_vals_get(plane_plane_angle_section, &
230 explicit=my_subsection(13))
231 CALL section_vals_get(gyration_section, explicit=my_subsection(14))
232 CALL section_vals_get(rmsd_section, explicit=my_subsection(15))
233 CALL section_vals_get(xyz_diag_section, explicit=my_subsection(17))
234 CALL section_vals_get(xyz_outerdiag_section, explicit=my_subsection(18))
235 CALL section_vals_get(u_section, explicit=my_subsection(19))
236 CALL section_vals_get(wc_section, explicit=my_subsection(20))
237 CALL section_vals_get(hbp_section, explicit=my_subsection(21))
238 CALL section_vals_get(ring_puckering_section, &
239 explicit=my_subsection(22))
240 CALL section_vals_get(mindist_section, explicit=my_subsection(23))
241 CALL section_vals_get(acid_hyd_dist_section, explicit=my_subsection(24))
242 CALL section_vals_get(acid_hyd_shell_section, explicit=my_subsection(25))
243 CALL section_vals_get(hydronium_dist_section, explicit=my_subsection(26))
244 CALL section_vals_get(voronoiipz_section, explicit=my_subsection(27))
245
246 ! Only one colvar can be present
247 cpassert(count(my_subsection) == 1)
248 cpassert(.NOT. ASSOCIATED(colvar))
249
250 IF (my_subsection(1)) THEN
251 ! Distance
252 wrk_section => distance_section
253 CALL colvar_create(colvar, dist_colvar_id)
254 CALL colvar_check_points(colvar, distance_section, cell)
255 CALL section_vals_val_get(distance_section, "ATOMS", i_vals=iatms)
256 colvar%dist_param%i_at = iatms(1)
257 colvar%dist_param%j_at = iatms(2)
258 CALL section_vals_val_get(distance_section, "AXIS", i_val=colvar%dist_param%axis_id)
259 CALL section_vals_val_get(distance_section, "SIGN", l_val=colvar%dist_param%sign_d)
260 ELSE IF (my_subsection(2)) THEN
261 ! Angle
262 wrk_section => angle_section
263 CALL colvar_create(colvar, angle_colvar_id)
264 CALL colvar_check_points(colvar, angle_section, cell)
265 CALL section_vals_val_get(angle_section, "ATOMS", i_vals=iatms)
266 colvar%angle_param%i_at_angle = iatms
267 ELSE IF (my_subsection(3)) THEN
268 ! Torsion
269 wrk_section => torsion_section
270 CALL colvar_create(colvar, torsion_colvar_id)
271 CALL colvar_check_points(colvar, torsion_section, cell)
272 CALL section_vals_val_get(torsion_section, "ATOMS", i_vals=iatms)
273 colvar%torsion_param%i_at_tors = iatms
274 colvar%torsion_param%o0 = 0.0_dp
275 ELSE IF (my_subsection(4)) THEN
276 ! Coordination
277 wrk_section => coordination_section
278 CALL colvar_create(colvar, coord_colvar_id)
279 CALL colvar_check_points(colvar, coordination_section, cell)
280 NULLIFY (colvar%coord_param%i_at_from, colvar%coord_param%c_kinds_from)
281 NULLIFY (colvar%coord_param%i_at_to, colvar%coord_param%c_kinds_to)
282 NULLIFY (colvar%coord_param%i_at_to_b, colvar%coord_param%c_kinds_to_b)
283 ! This section can be repeated
284 CALL section_vals_val_get(coordination_section, "ATOMS_FROM", n_rep_val=n_var)
285 ndim = 0
286 IF (n_var /= 0) THEN
287 ! INDEX LIST
288 DO k = 1, n_var
289 CALL section_vals_val_get(coordination_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms)
290 CALL reallocate(colvar%coord_param%i_at_from, 1, ndim + SIZE(iatms))
291 colvar%coord_param%i_at_from(ndim + 1:ndim + SIZE(iatms)) = iatms
292 ndim = ndim + SIZE(iatms)
293 END DO
294 colvar%coord_param%n_atoms_from = ndim
295 colvar%coord_param%use_kinds_from = .false.
296 ELSE
297 ! KINDS
298 CALL section_vals_val_get(coordination_section, "KINDS_FROM", n_rep_val=n_var)
299 cpassert(n_var > 0)
300 DO k = 1, n_var
301 CALL section_vals_val_get(coordination_section, "KINDS_FROM", i_rep_val=k, c_vals=c_kinds)
302 CALL reallocate(colvar%coord_param%c_kinds_from, 1, ndim + SIZE(c_kinds))
303 colvar%coord_param%c_kinds_from(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
304 ndim = ndim + SIZE(c_kinds)
305 END DO
306 colvar%coord_param%n_atoms_from = 0
307 colvar%coord_param%use_kinds_from = .true.
308 ! Uppercase the label
309 DO k = 1, ndim
310 CALL uppercase(colvar%coord_param%c_kinds_from(k))
311 END DO
312 END IF
313 ! This section can be repeated
314 CALL section_vals_val_get(coordination_section, "ATOMS_TO", n_rep_val=n_var)
315 ndim = 0
316 IF (n_var /= 0) THEN
317 ! INDEX LIST
318 DO k = 1, n_var
319 CALL section_vals_val_get(coordination_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms)
320 CALL reallocate(colvar%coord_param%i_at_to, 1, ndim + SIZE(iatms))
321 colvar%coord_param%i_at_to(ndim + 1:ndim + SIZE(iatms)) = iatms
322 ndim = ndim + SIZE(iatms)
323 END DO
324 colvar%coord_param%n_atoms_to = ndim
325 colvar%coord_param%use_kinds_to = .false.
326 ELSE
327 ! KINDS
328 CALL section_vals_val_get(coordination_section, "KINDS_TO", n_rep_val=n_var)
329 cpassert(n_var > 0)
330 DO k = 1, n_var
331 CALL section_vals_val_get(coordination_section, "KINDS_TO", i_rep_val=k, c_vals=c_kinds)
332 CALL reallocate(colvar%coord_param%c_kinds_to, 1, ndim + SIZE(c_kinds))
333 colvar%coord_param%c_kinds_to(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
334 ndim = ndim + SIZE(c_kinds)
335 END DO
336 colvar%coord_param%n_atoms_to = 0
337 colvar%coord_param%use_kinds_to = .true.
338 ! Uppercase the label
339 DO k = 1, ndim
340 CALL uppercase(colvar%coord_param%c_kinds_to(k))
341 END DO
342 END IF
343 ! Let's finish reading the other parameters
344 CALL section_vals_val_get(coordination_section, "R0", r_val=colvar%coord_param%r_0)
345 CALL section_vals_val_get(coordination_section, "NN", i_val=colvar%coord_param%nncrd)
346 CALL section_vals_val_get(coordination_section, "ND", i_val=colvar%coord_param%ndcrd)
347 ! This section can be repeated
348 CALL section_vals_val_get(coordination_section, "ATOMS_TO_B", n_rep_val=n_var)
349 CALL section_vals_val_get(coordination_section, "KINDS_TO_B", n_rep_val=n_var_k)
350 ndim = 0
351 IF (n_var /= 0 .OR. n_var_k /= 0) THEN
352 colvar%coord_param%do_chain = .true.
353 IF (n_var /= 0) THEN
354 ! INDEX LIST
355 DO k = 1, n_var
356 CALL section_vals_val_get(coordination_section, "ATOMS_TO_B", i_rep_val=k, i_vals=iatms)
357 CALL reallocate(colvar%coord_param%i_at_to_b, 1, ndim + SIZE(iatms))
358 colvar%coord_param%i_at_to_b(ndim + 1:ndim + SIZE(iatms)) = iatms
359 ndim = ndim + SIZE(iatms)
360 END DO
361 colvar%coord_param%n_atoms_to_b = ndim
362 colvar%coord_param%use_kinds_to_b = .false.
363 ELSE
364 ! KINDS
365 CALL section_vals_val_get(coordination_section, "KINDS_TO_B", n_rep_val=n_var_k)
366 cpassert(n_var_k > 0)
367 DO k = 1, n_var_k
368 CALL section_vals_val_get(coordination_section, "KINDS_TO_B", i_rep_val=k, c_vals=c_kinds)
369 CALL reallocate(colvar%coord_param%c_kinds_to_b, 1, ndim + SIZE(c_kinds))
370 colvar%coord_param%c_kinds_to_b(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
371 ndim = ndim + SIZE(c_kinds)
372 END DO
373 colvar%coord_param%n_atoms_to_b = 0
374 colvar%coord_param%use_kinds_to_b = .true.
375 ! Uppercase the label
376 DO k = 1, ndim
377 CALL uppercase(colvar%coord_param%c_kinds_to_b(k))
378 END DO
379 END IF
380 ! Let's finish reading the other parameters
381 CALL section_vals_val_get(coordination_section, "R0_B", r_val=colvar%coord_param%r_0_b)
382 CALL section_vals_val_get(coordination_section, "NN_B", i_val=colvar%coord_param%nncrd_b)
383 CALL section_vals_val_get(coordination_section, "ND_B", i_val=colvar%coord_param%ndcrd_b)
384 ELSE
385 colvar%coord_param%do_chain = .false.
386 colvar%coord_param%n_atoms_to_b = 0
387 colvar%coord_param%use_kinds_to_b = .false.
388 NULLIFY (colvar%coord_param%i_at_to_b)
389 NULLIFY (colvar%coord_param%c_kinds_to_b)
390 colvar%coord_param%nncrd_b = 0
391 colvar%coord_param%ndcrd_b = 0
392 colvar%coord_param%r_0_b = 0._dp
393 END IF
394
395 ELSE IF (my_subsection(5)) THEN
396 ! Distance point from plane
397 wrk_section => plane_dist_section
398 CALL colvar_create(colvar, plane_distance_colvar_id)
399 CALL colvar_check_points(colvar, plane_dist_section, cell)
400 CALL section_vals_val_get(plane_dist_section, "ATOMS_PLANE", i_vals=iatms)
401 cpassert(SIZE(iatms) == 3)
402 colvar%plane_distance_param%plane = iatms
403 CALL section_vals_val_get(plane_dist_section, "ATOM_POINT", i_val=iatm)
404 colvar%plane_distance_param%point = iatm
405 CALL section_vals_val_get(plane_dist_section, "PBC", l_val=colvar%plane_distance_param%use_pbc)
406 ELSE IF (my_subsection(6)) THEN
407 ! Rotation colvar of a segment w.r.t. another segment
408 wrk_section => rotation_section
409 CALL colvar_create(colvar, rotation_colvar_id)
410 CALL colvar_check_points(colvar, rotation_section, cell)
411 CALL section_vals_val_get(rotation_section, "P1_BOND1", i_val=colvar%rotation_param%i_at1_bond1)
412 CALL section_vals_val_get(rotation_section, "P2_BOND1", i_val=colvar%rotation_param%i_at2_bond1)
413 CALL section_vals_val_get(rotation_section, "P1_BOND2", i_val=colvar%rotation_param%i_at1_bond2)
414 CALL section_vals_val_get(rotation_section, "P2_BOND2", i_val=colvar%rotation_param%i_at2_bond2)
415 ELSE IF (my_subsection(7)) THEN
416 ! Difference of two distances
417 wrk_section => dfunct_section
418 CALL colvar_create(colvar, dfunct_colvar_id)
419 CALL colvar_check_points(colvar, dfunct_section, cell)
420 CALL section_vals_val_get(dfunct_section, "ATOMS", i_vals=iatms)
421 colvar%dfunct_param%i_at_dfunct = iatms
422 CALL section_vals_val_get(dfunct_section, "COEFFICIENT", r_val=colvar%dfunct_param%coeff)
423 CALL section_vals_val_get(dfunct_section, "PBC", l_val=colvar%dfunct_param%use_pbc)
424 ELSE IF (my_subsection(8)) THEN
425 ! Q Parameter
426 wrk_section => qparm_section
427 CALL colvar_create(colvar, qparm_colvar_id)
428 CALL colvar_check_points(colvar, qparm_section, cell)
429 CALL section_vals_val_get(qparm_section, "RCUT", r_val=colvar%qparm_param%rcut)
430 CALL section_vals_val_get(qparm_section, "RSTART", r_val=colvar%qparm_param%rstart)
431 CALL section_vals_val_get(qparm_section, "INCLUDE_IMAGES", l_val=colvar%qparm_param%include_images)
432 !CALL section_vals_val_get(qparm_section, "ALPHA", r_val=colvar%qparm_param%alpha)
433 CALL section_vals_val_get(qparm_section, "L", i_val=colvar%qparm_param%l)
434 NULLIFY (colvar%qparm_param%i_at_from)
435 NULLIFY (colvar%qparm_param%i_at_to)
436 CALL section_vals_val_get(qparm_section, "ATOMS_FROM", n_rep_val=n_var)
437 ndim = 0
438 DO k = 1, n_var
439 CALL section_vals_val_get(qparm_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms)
440 CALL reallocate(colvar%qparm_param%i_at_from, 1, ndim + SIZE(iatms))
441 colvar%qparm_param%i_at_from(ndim + 1:ndim + SIZE(iatms)) = iatms
442 ndim = ndim + SIZE(iatms)
443 END DO
444 colvar%qparm_param%n_atoms_from = ndim
445 ! This section can be repeated
446 CALL section_vals_val_get(qparm_section, "ATOMS_TO", n_rep_val=n_var)
447 ndim = 0
448 DO k = 1, n_var
449 CALL section_vals_val_get(qparm_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms)
450 CALL reallocate(colvar%qparm_param%i_at_to, 1, ndim + SIZE(iatms))
451 colvar%qparm_param%i_at_to(ndim + 1:ndim + SIZE(iatms)) = iatms
452 ndim = ndim + SIZE(iatms)
453 END DO
454 colvar%qparm_param%n_atoms_to = ndim
455 ELSE IF (my_subsection(9)) THEN
456 ! Hydronium
457 CALL colvar_create(colvar, hydronium_shell_colvar_id)
458 NULLIFY (colvar%hydronium_shell_param%i_oxygens)
459 NULLIFY (colvar%hydronium_shell_param%i_hydrogens)
460 CALL read_hydronium_colvars(hydronium_shell_section, colvar, hydronium_shell_colvar_id, &
461 colvar%hydronium_shell_param%n_oxygens, &
462 colvar%hydronium_shell_param%n_hydrogens, &
463 colvar%hydronium_shell_param%i_oxygens, &
464 colvar%hydronium_shell_param%i_hydrogens)
465 ELSE IF (my_subsection(10) .OR. my_subsection(16)) THEN
466 !reaction path or distance from reaction path
467 IF (my_subsection(10)) THEN
468 path_section => reaction_path_section
469 CALL colvar_create(colvar, reaction_path_colvar_id)
470 fmid = "POS"
471 ifunc = 1
472 ELSE IF (my_subsection(16)) THEN
473 path_section => distance_from_path_section
474 CALL colvar_create(colvar, distance_from_path_colvar_id)
475 fmid = "DIS"
476 ifunc = 2
477 END IF
478 colvar%use_points = .false.
479 CALL section_vals_val_get(path_section, "LAMBDA", r_val=colvar%reaction_path_param%lambda)
480 CALL section_vals_val_get(path_section, "DISTANCES_RMSD", l_val=colvar%reaction_path_param%dist_rmsd)
481 CALL section_vals_val_get(path_section, "RMSD", l_val=colvar%reaction_path_param%rmsd)
482 IF (colvar%reaction_path_param%dist_rmsd .AND. colvar%reaction_path_param%rmsd) THEN
483 cpabort("CV REACTION PATH: only one between DISTANCES_RMSD and RMSD can be used ")
484 END IF
485 IF (colvar%reaction_path_param%dist_rmsd .OR. colvar%reaction_path_param%rmsd) THEN
486 NULLIFY (colvar%reaction_path_param%i_rmsd, colvar%reaction_path_param%r_ref)
487 frame_section => section_vals_get_subs_vals(path_section, "FRAME")
488 CALL section_vals_get(frame_section, n_repetition=nr_frame)
489
490 colvar%reaction_path_param%nr_frames = nr_frame
491 CALL read_frames(frame_section, para_env, nr_frame, colvar%reaction_path_param%r_ref, &
492 colvar%reaction_path_param%n_components)
493 CALL section_vals_val_get(path_section, "SUBSET_TYPE", i_val=colvar%reaction_path_param%subset)
494 IF (colvar%reaction_path_param%subset == rmsd_all) THEN
495 ALLOCATE (colvar%reaction_path_param%i_rmsd(colvar%reaction_path_param%n_components))
496 DO i = 1, colvar%reaction_path_param%n_components
497 colvar%reaction_path_param%i_rmsd(i) = i
498 END DO
499 ELSE IF (colvar%reaction_path_param%subset == rmsd_list) THEN
500 ! This section can be repeated
501 CALL section_vals_val_get(path_section, "ATOMS", n_rep_val=n_var)
502 ndim = 0
503 IF (n_var /= 0) THEN
504 ! INDEX LIST
505 DO k = 1, n_var
506 CALL section_vals_val_get(path_section, "ATOMS", i_rep_val=k, i_vals=iatms)
507 CALL reallocate(colvar%reaction_path_param%i_rmsd, 1, ndim + SIZE(iatms))
508 colvar%reaction_path_param%i_rmsd(ndim + 1:ndim + SIZE(iatms)) = iatms
509 ndim = ndim + SIZE(iatms)
510 END DO
511 colvar%reaction_path_param%n_components = ndim
512 ELSE
513 cpabort("CV REACTION PATH: if SUBSET_TYPE=LIST a list of atoms needs to be provided ")
514 END IF
515 END IF
516
517 CALL section_vals_val_get(path_section, "ALIGN_FRAMES", l_val=colvar%reaction_path_param%align_frames)
518 ELSE
519 colvar_subsection => section_vals_get_subs_vals(path_section, "COLVAR")
520 CALL section_vals_get(colvar_subsection, n_repetition=ncol)
521 ALLOCATE (colvar%reaction_path_param%colvar_p(ncol))
522 IF (ncol > 0) THEN
523 DO i = 1, ncol
524 NULLIFY (colvar%reaction_path_param%colvar_p(i)%colvar)
525 CALL colvar_read(colvar%reaction_path_param%colvar_p(i)%colvar, i, colvar_subsection, para_env, cell)
526 END DO
527 ELSE
528 cpabort("CV REACTION PATH: the number of CV to define the path must be >0 ")
529 END IF
530 colvar%reaction_path_param%n_components = ncol
531 NULLIFY (range)
532 CALL section_vals_val_get(path_section, "RANGE", r_vals=range)
533 CALL section_vals_val_get(path_section, "STEP_SIZE", r_val=colvar%reaction_path_param%step_size)
534 iend = ceiling(max(range(1), range(2))/colvar%reaction_path_param%step_size)
535 istart = floor(min(range(1), range(2))/colvar%reaction_path_param%step_size)
536 colvar%reaction_path_param%function_bounds(1) = istart
537 colvar%reaction_path_param%function_bounds(2) = iend
538 colvar%reaction_path_param%nr_frames = 2 !iend - istart + 1
539 ALLOCATE (colvar%reaction_path_param%f_vals(ncol, istart:iend))
540 CALL section_vals_val_get(path_section, "VARIABLE", c_vals=my_par, i_rep_val=1)
541 CALL section_vals_val_get(path_section, "FUNCTION", n_rep_val=ncol)
542 check = (ncol == SIZE(colvar%reaction_path_param%colvar_p))
543 cpassert(check)
544 CALL initf(ncol)
545 DO i = 1, ncol
546 CALL section_vals_val_get(path_section, "FUNCTION", c_val=path_function, i_rep_val=i)
547 CALL compress(path_function, full=.true.)
548 CALL parsef(i, trim(path_function), my_par)
549 DO j = istart, iend
550 my_val = real(j, kind=dp)*colvar%reaction_path_param%step_size
551 colvar%reaction_path_param%f_vals(i, j) = evalf(i, my_val)
552 END DO
553 END DO
554 CALL finalizef()
555
556 iw1 = cp_print_key_unit_nr(logger, path_section, &
557 "MAP", middle_name=fmid, extension=".dat", file_status="REPLACE")
558 IF (iw1 > 0) THEN
559 CALL section_vals_val_get(path_section, "MAP%GRID_SPACING", n_rep_val=ncol)
560 ALLOCATE (grid_sp(ncol))
561 DO i = 1, ncol
562 CALL section_vals_val_get(path_section, "MAP%GRID_SPACING", r_val=grid_sp(i))
563 END DO
564 CALL section_vals_val_get(path_section, "MAP%RANGE", n_rep_val=ncol)
565 cpassert(ncol == SIZE(grid_sp))
566 ALLOCATE (p_range(2, ncol))
567 ALLOCATE (p_bounds(2, ncol))
568 DO i = 1, ncol
569 CALL section_vals_val_get(path_section, "MAP%RANGE", r_vals=g_range)
570 p_range(:, i) = g_range(:)
571 p_bounds(2, i) = ceiling(max(p_range(1, i), p_range(2, i))/grid_sp(i))
572 p_bounds(1, i) = floor(min(p_range(1, i), p_range(2, i))/grid_sp(i))
573 END DO
574 ALLOCATE (s1v(2, istart:iend))
575 ALLOCATE (s1(2))
576 ALLOCATE (grid_point(ncol))
577 v_count = 0
578 kk = rec_eval_grid(iw1, ncol, colvar%reaction_path_param%f_vals, v_count, &
579 grid_point, grid_sp, colvar%reaction_path_param%step_size, istart, &
580 iend, s1v, s1, p_bounds, colvar%reaction_path_param%lambda, ifunc=ifunc, &
581 nconf=colvar%reaction_path_param%nr_frames)
582 DEALLOCATE (grid_sp)
583 DEALLOCATE (p_range)
584 DEALLOCATE (p_bounds)
585 DEALLOCATE (s1v)
586 DEALLOCATE (s1)
587 DEALLOCATE (grid_point)
588 END IF
589 CALL cp_print_key_finished_output(iw1, logger, path_section, &
590 "MAP")
591 END IF
592
593 ELSE IF (my_subsection(11)) THEN
594 ! combine colvar
595 CALL colvar_create(colvar, combine_colvar_id)
596 colvar%use_points = .false.
597 colvar_subsection => section_vals_get_subs_vals(combine_section, "COLVAR")
598 CALL section_vals_get(colvar_subsection, n_repetition=ncol)
599 ALLOCATE (colvar%combine_cvs_param%colvar_p(ncol))
600 ! In case we need to print some information..
601 iw = cp_print_key_unit_nr(logger, colvar_section, &
602 "PRINT%PROGRAM_RUN_INFO", extension=".colvarLog")
603 IF (iw > 0) THEN
604 WRITE (iw, '( A )') ' '// &
605 '**********************************************************************'
606 WRITE (iw, '( A,I8)') ' COLVARS| COLVAR INPUT INDEX: ', icol
607 WRITE (iw, '( A,T49,4I8)') ' COLVARS| COMBINATION OF THE FOLLOWING COLVARS:'
608 END IF
609 CALL cp_print_key_finished_output(iw, logger, colvar_section, &
610 "PRINT%PROGRAM_RUN_INFO")
611 ! Parsing the real COLVARs
612 DO i = 1, ncol
613 NULLIFY (colvar%combine_cvs_param%colvar_p(i)%colvar)
614 CALL colvar_read(colvar%combine_cvs_param%colvar_p(i)%colvar, i, colvar_subsection, para_env, cell)
615 END DO
616 ! Function definition
617 CALL section_vals_val_get(combine_section, "FUNCTION", c_val=colvar%combine_cvs_param%function)
618 CALL compress(colvar%combine_cvs_param%function, full=.true.)
619 ! Variables
620 CALL section_vals_val_get(combine_section, "VARIABLES", c_vals=my_par)
621 ALLOCATE (colvar%combine_cvs_param%variables(SIZE(my_par)))
622 colvar%combine_cvs_param%variables = my_par
623 ! Check that the number of COLVAR provided is equal to the number of variables..
624 IF (SIZE(my_par) /= ncol) THEN
625 CALL cp_abort(__location__, &
626 "Number of defined COLVAR for COMBINE_COLVAR is different from the "// &
627 "number of variables! It is not possible to define COLVARs in a COMBINE_COLVAR "// &
628 "and avoid their usage in the combininig function!")
629 END IF
630 ! Parameters
631 ALLOCATE (colvar%combine_cvs_param%c_parameters(0))
632 CALL section_vals_val_get(combine_section, "PARAMETERS", n_rep_val=ncol)
633 DO i = 1, ncol
634 isize = SIZE(colvar%combine_cvs_param%c_parameters)
635 CALL section_vals_val_get(combine_section, "PARAMETERS", c_vals=my_par, i_rep_val=i)
636 CALL reallocate(colvar%combine_cvs_param%c_parameters, 1, isize + SIZE(my_par))
637 colvar%combine_cvs_param%c_parameters(isize + 1:isize + SIZE(my_par)) = my_par
638 END DO
639 ALLOCATE (colvar%combine_cvs_param%v_parameters(0))
640 CALL section_vals_val_get(combine_section, "VALUES", n_rep_val=ncol)
641 DO i = 1, ncol
642 isize = SIZE(colvar%combine_cvs_param%v_parameters)
643 CALL section_vals_val_get(combine_section, "VALUES", r_vals=my_vals, i_rep_val=i)
644 CALL reallocate(colvar%combine_cvs_param%v_parameters, 1, isize + SIZE(my_vals))
645 colvar%combine_cvs_param%v_parameters(isize + 1:isize + SIZE(my_vals)) = my_vals
646 END DO
647 ! Info on derivative evaluation
648 CALL section_vals_val_get(combine_section, "DX", r_val=colvar%combine_cvs_param%dx)
649 CALL section_vals_val_get(combine_section, "ERROR_LIMIT", r_val=colvar%combine_cvs_param%lerr)
650 ELSE IF (my_subsection(12)) THEN
651 ! Population
652 wrk_section => population_section
653 CALL colvar_create(colvar, population_colvar_id)
654 CALL colvar_check_points(colvar, population_section, cell)
655
656 NULLIFY (colvar%population_param%i_at_from, colvar%population_param%c_kinds_from)
657 NULLIFY (colvar%population_param%i_at_to, colvar%population_param%c_kinds_to)
658 ! This section can be repeated
659
660 CALL section_vals_val_get(population_section, "ATOMS_FROM", n_rep_val=n_var)
661 ndim = 0
662 IF (n_var /= 0) THEN
663 ! INDEX LIST
664 DO k = 1, n_var
665 CALL section_vals_val_get(population_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms)
666 CALL reallocate(colvar%population_param%i_at_from, 1, ndim + SIZE(iatms))
667 colvar%population_param%i_at_from(ndim + 1:ndim + SIZE(iatms)) = iatms
668 ndim = ndim + SIZE(iatms)
669 END DO
670 colvar%population_param%n_atoms_from = ndim
671 colvar%population_param%use_kinds_from = .false.
672 ELSE
673 ! KINDS
674 CALL section_vals_val_get(population_section, "KINDS_FROM", n_rep_val=n_var)
675 cpassert(n_var > 0)
676 DO k = 1, n_var
677 CALL section_vals_val_get(population_section, "KINDS_FROM", i_rep_val=k, c_vals=c_kinds)
678 CALL reallocate(colvar%population_param%c_kinds_from, 1, ndim + SIZE(c_kinds))
679 colvar%population_param%c_kinds_from(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
680 ndim = ndim + SIZE(c_kinds)
681 END DO
682 colvar%population_param%n_atoms_from = 0
683 colvar%population_param%use_kinds_from = .true.
684 ! Uppercase the label
685 DO k = 1, ndim
686 CALL uppercase(colvar%population_param%c_kinds_from(k))
687 END DO
688 END IF
689 ! This section can be repeated
690 CALL section_vals_val_get(population_section, "ATOMS_TO", n_rep_val=n_var)
691 ndim = 0
692 IF (n_var /= 0) THEN
693 ! INDEX LIST
694 DO k = 1, n_var
695 CALL section_vals_val_get(population_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms)
696 CALL reallocate(colvar%population_param%i_at_to, 1, ndim + SIZE(iatms))
697 colvar%population_param%i_at_to(ndim + 1:ndim + SIZE(iatms)) = iatms
698 ndim = ndim + SIZE(iatms)
699 END DO
700 colvar%population_param%n_atoms_to = ndim
701 colvar%population_param%use_kinds_to = .false.
702 ELSE
703 ! KINDS
704 CALL section_vals_val_get(population_section, "KINDS_TO", n_rep_val=n_var)
705 cpassert(n_var > 0)
706 DO k = 1, n_var
707 CALL section_vals_val_get(population_section, "KINDS_TO", i_rep_val=k, c_vals=c_kinds)
708 CALL reallocate(colvar%population_param%c_kinds_to, 1, ndim + SIZE(c_kinds))
709 colvar%population_param%c_kinds_to(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
710 ndim = ndim + SIZE(c_kinds)
711 END DO
712 colvar%population_param%n_atoms_to = 0
713 colvar%population_param%use_kinds_to = .true.
714 ! Uppercase the label
715 DO k = 1, ndim
716 CALL uppercase(colvar%population_param%c_kinds_to(k))
717 END DO
718 END IF
719 ! Let's finish reading the other parameters
720 CALL section_vals_val_get(population_section, "R0", r_val=colvar%population_param%r_0)
721 CALL section_vals_val_get(population_section, "NN", i_val=colvar%population_param%nncrd)
722 CALL section_vals_val_get(population_section, "ND", i_val=colvar%population_param%ndcrd)
723 CALL section_vals_val_get(population_section, "N0", i_val=colvar%population_param%n0)
724 CALL section_vals_val_get(population_section, "SIGMA", r_val=colvar%population_param%sigma)
725 ELSE IF (my_subsection(13)) THEN
726 ! Angle between two planes
727 wrk_section => plane_plane_angle_section
728 CALL colvar_create(colvar, plane_plane_angle_colvar_id)
729 CALL colvar_check_points(colvar, plane_plane_angle_section, cell)
730 ! Read the specification of the two planes
731 plane_sections => section_vals_get_subs_vals(plane_plane_angle_section, "PLANE")
732 CALL section_vals_get(plane_sections, n_repetition=n_var)
733 IF (n_var /= 2) THEN
734 cpabort("PLANE_PLANE_ANGLE Colvar section: Two PLANE sections must be provided!")
735 END IF
736 ! Plane 1
737 CALL section_vals_val_get(plane_sections, "DEF_TYPE", i_rep_section=1, &
738 i_val=colvar%plane_plane_angle_param%plane1%type_of_def)
739 IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_vec) THEN
740 CALL section_vals_val_get(plane_sections, "NORMAL_VECTOR", i_rep_section=1, &
741 r_vals=s1)
742 colvar%plane_plane_angle_param%plane1%normal_vec = s1
743 IF (PRESENT(cell)) THEN
744 IF (ASSOCIATED(cell)) THEN
745 CALL cell_transform_input_cartesian(cell, colvar%plane_plane_angle_param%plane1%normal_vec)
746 END IF
747 END IF
748 ELSE
749 CALL section_vals_val_get(plane_sections, "ATOMS", i_rep_section=1, &
750 i_vals=iatms)
751 colvar%plane_plane_angle_param%plane1%points = iatms
752 END IF
753
754 ! Plane 2
755 CALL section_vals_val_get(plane_sections, "DEF_TYPE", i_rep_section=2, &
756 i_val=colvar%plane_plane_angle_param%plane2%type_of_def)
757 IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_vec) THEN
758 CALL section_vals_val_get(plane_sections, "NORMAL_VECTOR", i_rep_section=2, &
759 r_vals=s1)
760 colvar%plane_plane_angle_param%plane2%normal_vec = s1
761 IF (PRESENT(cell)) THEN
762 IF (ASSOCIATED(cell)) THEN
763 CALL cell_transform_input_cartesian(cell, colvar%plane_plane_angle_param%plane2%normal_vec)
764 END IF
765 END IF
766 ELSE
767 CALL section_vals_val_get(plane_sections, "ATOMS", i_rep_section=2, &
768 i_vals=iatms)
769 colvar%plane_plane_angle_param%plane2%points = iatms
770 END IF
771 ELSE IF (my_subsection(14)) THEN
772 ! Gyration Radius
773 wrk_section => gyration_section
774 CALL colvar_create(colvar, gyration_colvar_id)
775 CALL colvar_check_points(colvar, gyration_section, cell)
776
777 NULLIFY (colvar%gyration_param%i_at, colvar%gyration_param%c_kinds)
778
779 ! This section can be repeated
780 CALL section_vals_val_get(gyration_section, "ATOMS", n_rep_val=n_var)
781 ndim = 0
782 IF (n_var /= 0) THEN
783 ! INDEX LIST
784 DO k = 1, n_var
785 CALL section_vals_val_get(gyration_section, "ATOMS", i_rep_val=k, i_vals=iatms)
786 CALL reallocate(colvar%gyration_param%i_at, 1, ndim + SIZE(iatms))
787 colvar%gyration_param%i_at(ndim + 1:ndim + SIZE(iatms)) = iatms
788 ndim = ndim + SIZE(iatms)
789 END DO
790 colvar%gyration_param%n_atoms = ndim
791 colvar%gyration_param%use_kinds = .false.
792 ELSE
793 ! KINDS
794 CALL section_vals_val_get(gyration_section, "KINDS", n_rep_val=n_var)
795 cpassert(n_var > 0)
796 DO k = 1, n_var
797 CALL section_vals_val_get(gyration_section, "KINDS", i_rep_val=k, c_vals=c_kinds)
798 CALL reallocate(colvar%gyration_param%c_kinds, 1, ndim + SIZE(c_kinds))
799 colvar%gyration_param%c_kinds(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
800 ndim = ndim + SIZE(c_kinds)
801 END DO
802 colvar%gyration_param%n_atoms = 0
803 colvar%gyration_param%use_kinds = .true.
804 ! Uppercase the label
805 DO k = 1, ndim
806 CALL uppercase(colvar%gyration_param%c_kinds(k))
807 END DO
808 END IF
809 ELSE IF (my_subsection(15)) THEN
810 ! RMSD_AB
811 wrk_section => rmsd_section
812 CALL colvar_create(colvar, rmsd_colvar_id)
813
814 NULLIFY (colvar%rmsd_param%i_rmsd, colvar%rmsd_param%r_ref, colvar%rmsd_param%weights)
815
816 frame_section => section_vals_get_subs_vals(rmsd_section, "FRAME")
817 CALL section_vals_get(frame_section, n_repetition=nr_frame)
818
819 colvar%rmsd_param%nr_frames = nr_frame
820 ! Calculation is aborted if reference frame are less than 1 and more than 2
821 cpassert(nr_frame >= 1 .AND. nr_frame <= 2)
822 CALL read_frames(frame_section, para_env, nr_frame, colvar%rmsd_param%r_ref, &
823 colvar%rmsd_param%n_atoms)
824 ALLOCATE (colvar%rmsd_param%weights(colvar%rmsd_param%n_atoms))
825 colvar%rmsd_param%weights = 0.0_dp
826 CALL section_vals_val_get(rmsd_section, "SUBSET_TYPE", i_val=colvar%rmsd_param%subset)
827 IF (colvar%rmsd_param%subset == rmsd_all) THEN
828 ALLOCATE (colvar%rmsd_param%i_rmsd(colvar%rmsd_param%n_atoms))
829 DO i = 1, colvar%rmsd_param%n_atoms
830 colvar%rmsd_param%i_rmsd(i) = i
831 END DO
832 ELSE IF (colvar%rmsd_param%subset == rmsd_list) THEN
833 ! This section can be repeated
834 CALL section_vals_val_get(rmsd_section, "ATOMS", n_rep_val=n_var)
835 ndim = 0
836 IF (n_var /= 0) THEN
837 ! INDEX LIST
838 DO k = 1, n_var
839 CALL section_vals_val_get(rmsd_section, "ATOMS", i_rep_val=k, i_vals=iatms)
840 CALL reallocate(colvar%rmsd_param%i_rmsd, 1, ndim + SIZE(iatms))
841 colvar%rmsd_param%i_rmsd(ndim + 1:ndim + SIZE(iatms)) = iatms
842 ndim = ndim + SIZE(iatms)
843 END DO
844 colvar%rmsd_param%n_atoms = ndim
845 ELSE
846 cpabort("CV RMSD: if SUBSET_TYPE=LIST a list of atoms needs to be provided ")
847 END IF
848 ELSE IF (colvar%rmsd_param%subset == rmsd_weightlist) THEN
849 CALL section_vals_val_get(rmsd_section, "ATOMS", n_rep_val=n_var)
850 ndim = 0
851 IF (n_var /= 0) THEN
852 ! INDEX LIST
853 DO k = 1, n_var
854 CALL section_vals_val_get(rmsd_section, "ATOMS", i_rep_val=k, i_vals=iatms)
855 CALL reallocate(colvar%rmsd_param%i_rmsd, 1, ndim + SIZE(iatms))
856 colvar%rmsd_param%i_rmsd(ndim + 1:ndim + SIZE(iatms)) = iatms
857 ndim = ndim + SIZE(iatms)
858 END DO
859 colvar%rmsd_param%n_atoms = ndim
860 ELSE
861 cpabort("CV RMSD: if SUBSET_TYPE=WEIGHT_LIST a list of atoms needs to be provided ")
862 END IF
863 CALL section_vals_val_get(rmsd_section, "WEIGHTS", n_rep_val=n_var)
864 ndim = 0
865 IF (n_var /= 0) THEN
866 ! INDEX LIST
867 DO k = 1, n_var
868 CALL section_vals_val_get(rmsd_section, "WEIGHTS", i_rep_val=k, r_vals=wei)
869 CALL reallocate(weights, 1, ndim + SIZE(wei))
870 weights(ndim + 1:ndim + SIZE(wei)) = wei
871 ndim = ndim + SIZE(wei)
872 END DO
873 IF (ndim /= colvar%rmsd_param%n_atoms) THEN
874 CALL cp_abort(__location__, "CV RMSD: list of atoms and list of "// &
875 "weights need to contain same number of entries. ")
876 END IF
877 DO i = 1, ndim
878 ii = colvar%rmsd_param%i_rmsd(i)
879 colvar%rmsd_param%weights(ii) = weights(i)
880 END DO
881 DEALLOCATE (weights)
882 ELSE
883 cpabort("CV RMSD: if SUBSET_TYPE=WEIGHT_LIST a list of weights need to be provided. ")
884 END IF
885
886 ELSE
887 cpabort("CV RMSD: unknown SUBSET_TYPE.")
888 END IF
889
890 CALL section_vals_val_get(rmsd_section, "ALIGN_FRAMES", l_val=colvar%rmsd_param%align_frames)
891
892 ELSE IF (my_subsection(17)) THEN
893 ! Work on XYZ positions of atoms
894 wrk_section => xyz_diag_section
895 CALL colvar_create(colvar, xyz_diag_colvar_id)
896 CALL colvar_check_points(colvar, wrk_section, cell)
897 CALL section_vals_val_get(wrk_section, "ATOM", i_val=iatm)
898 CALL section_vals_val_get(wrk_section, "COMPONENT", i_val=icomponent)
899 CALL section_vals_val_get(wrk_section, "PBC", l_val=colvar%xyz_diag_param%use_pbc)
900 CALL section_vals_val_get(wrk_section, "ABSOLUTE_POSITION", l_val=colvar%xyz_diag_param%use_absolute_position)
901 colvar%xyz_diag_param%i_atom = iatm
902 colvar%xyz_diag_param%component = icomponent
903 ELSE IF (my_subsection(18)) THEN
904 ! Work on the outer diagonal (two atoms A,B) XYZ positions
905 wrk_section => xyz_outerdiag_section
906 CALL colvar_create(colvar, xyz_outerdiag_colvar_id)
907 CALL colvar_check_points(colvar, wrk_section, cell)
908 CALL section_vals_val_get(wrk_section, "ATOMS", i_vals=iatms)
909 colvar%xyz_outerdiag_param%i_atoms = iatms
910 CALL section_vals_val_get(wrk_section, "COMPONENT_A", i_val=icomponent)
911 colvar%xyz_outerdiag_param%components(1) = icomponent
912 CALL section_vals_val_get(wrk_section, "COMPONENT_B", i_val=icomponent)
913 colvar%xyz_outerdiag_param%components(2) = icomponent
914 CALL section_vals_val_get(wrk_section, "PBC", l_val=colvar%xyz_outerdiag_param%use_pbc)
915 ELSE IF (my_subsection(19)) THEN
916 ! Energy
917 wrk_section => u_section
918 CALL colvar_create(colvar, u_colvar_id)
919 colvar%u_param%mixed_energy_section => section_vals_get_subs_vals(wrk_section, "MIXED")
920 CALL section_vals_get(colvar%u_param%mixed_energy_section, explicit=use_mixed_energy)
921 IF (.NOT. use_mixed_energy) NULLIFY (colvar%u_param%mixed_energy_section)
922 ELSE IF (my_subsection(20)) THEN
923 ! Wc hydrogen bond
924 wrk_section => wc_section
925 CALL colvar_create(colvar, wc_colvar_id)
926 CALL colvar_check_points(colvar, wc_section, cell)
927 CALL section_vals_val_get(wc_section, "ATOMS", i_vals=iatms)
928 CALL section_vals_val_get(wrk_section, "RCUT", r_val=my_val(1))
929 colvar%Wc%rcut = cp_unit_to_cp2k(my_val(1), "angstrom")
930 colvar%Wc%ids = iatms
931 ELSE IF (my_subsection(21)) THEN
932 ! HBP colvar
933 wrk_section => hbp_section
934 CALL colvar_create(colvar, hbp_colvar_id)
935 CALL colvar_check_points(colvar, hbp_section, cell)
936 CALL section_vals_val_get(wrk_section, "NPOINTS", i_val=colvar%HBP%nPoints)
937 CALL section_vals_val_get(wrk_section, "RCUT", r_val=my_val(1))
938 colvar%HBP%rcut = cp_unit_to_cp2k(my_val(1), "angstrom")
939 CALL section_vals_val_get(wrk_section, "RCUT", r_val=colvar%HBP%shift)
940
941 ALLOCATE (colvar%HBP%ids(colvar%HBP%nPoints, 3))
942 ALLOCATE (colvar%HBP%ewc(colvar%HBP%nPoints))
943 DO i = 1, colvar%HBP%nPoints
944 CALL section_vals_val_get(wrk_section, "ATOMS", i_rep_val=i, i_vals=iatms)
945 colvar%HBP%ids(i, :) = iatms
946 END DO
947 ELSE IF (my_subsection(22)) THEN
948 ! Ring Puckering
949 CALL colvar_create(colvar, ring_puckering_colvar_id)
950 CALL section_vals_val_get(ring_puckering_section, "ATOMS", i_vals=iatms)
951 colvar%ring_puckering_param%nring = SIZE(iatms)
952 ALLOCATE (colvar%ring_puckering_param%atoms(SIZE(iatms)))
953 colvar%ring_puckering_param%atoms = iatms
954 CALL section_vals_val_get(ring_puckering_section, "COORDINATE", &
955 i_val=colvar%ring_puckering_param%iq)
956 ! test the validity of the parameters
957 ndim = colvar%ring_puckering_param%nring
958 IF (ndim <= 3) THEN
959 cpabort("CV Ring Puckering: Ring size has to be 4 or larger. ")
960 END IF
961 ii = colvar%ring_puckering_param%iq
962 IF (abs(ii) == 1 .OR. ii < -(ndim - 1)/2 .OR. ii > ndim/2) THEN
963 cpabort("CV Ring Puckering: Invalid coordinate number.")
964 END IF
965 ELSE IF (my_subsection(23)) THEN
966 ! Minimum Distance
967 wrk_section => mindist_section
968 CALL colvar_create(colvar, mindist_colvar_id)
969 CALL colvar_check_points(colvar, mindist_section, cell)
970 NULLIFY (colvar%mindist_param%i_dist_from, colvar%mindist_param%i_coord_from, &
971 colvar%mindist_param%k_coord_from, colvar%mindist_param%i_coord_to, &
972 colvar%mindist_param%k_coord_to)
973 CALL section_vals_val_get(mindist_section, "ATOMS_DISTANCE", i_vals=iatms)
974 colvar%mindist_param%n_dist_from = SIZE(iatms)
975 ALLOCATE (colvar%mindist_param%i_dist_from(SIZE(iatms)))
976 colvar%mindist_param%i_dist_from = iatms
977 CALL section_vals_val_get(mindist_section, "ATOMS_FROM", n_rep_val=n_var)
978 ndim = 0
979 IF (n_var /= 0) THEN
980 ! INDEX LIST
981 DO k = 1, n_var
982 CALL section_vals_val_get(mindist_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms)
983 CALL reallocate(colvar%mindist_param%i_coord_from, 1, ndim + SIZE(iatms))
984 colvar%mindist_param%i_coord_from(ndim + 1:ndim + SIZE(iatms)) = iatms
985 ndim = ndim + SIZE(iatms)
986 END DO
987 colvar%mindist_param%n_coord_from = ndim
988 colvar%mindist_param%use_kinds_from = .false.
989 ELSE
990 !KINDS
991 CALL section_vals_val_get(mindist_section, "KINDS_FROM", n_rep_val=n_var)
992 cpassert(n_var > 0)
993 DO k = 1, n_var
994 CALL section_vals_val_get(mindist_section, "KINDS_FROM", i_rep_val=k, c_vals=c_kinds)
995 CALL reallocate(colvar%mindist_param%k_coord_from, 1, ndim + SIZE(c_kinds))
996 colvar%mindist_param%k_coord_from(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
997 ndim = ndim + SIZE(c_kinds)
998 END DO
999 colvar%mindist_param%n_coord_from = 0
1000 colvar%mindist_param%use_kinds_from = .true.
1001 ! Uppercase the label
1002 DO k = 1, ndim
1003 CALL uppercase(colvar%mindist_param%k_coord_from(k))
1004 END DO
1005 END IF
1006
1007 CALL section_vals_val_get(mindist_section, "ATOMS_TO", n_rep_val=n_var)
1008 ndim = 0
1009 IF (n_var /= 0) THEN
1010 ! INDEX LIST
1011 DO k = 1, n_var
1012 CALL section_vals_val_get(mindist_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms)
1013 CALL reallocate(colvar%mindist_param%i_coord_to, 1, ndim + SIZE(iatms))
1014 colvar%mindist_param%i_coord_to(ndim + 1:ndim + SIZE(iatms)) = iatms
1015 ndim = ndim + SIZE(iatms)
1016 END DO
1017 colvar%mindist_param%n_coord_to = ndim
1018 colvar%mindist_param%use_kinds_to = .false.
1019 ELSE
1020 !KINDS
1021 CALL section_vals_val_get(mindist_section, "KINDS_TO", n_rep_val=n_var)
1022 cpassert(n_var > 0)
1023 DO k = 1, n_var
1024 CALL section_vals_val_get(mindist_section, "KINDS_TO", i_rep_val=k, c_vals=c_kinds)
1025 CALL reallocate(colvar%mindist_param%k_coord_to, 1, ndim + SIZE(c_kinds))
1026 colvar%mindist_param%k_coord_to(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds
1027 ndim = ndim + SIZE(c_kinds)
1028 END DO
1029 colvar%mindist_param%n_coord_to = 0
1030 colvar%mindist_param%use_kinds_to = .true.
1031 ! Uppercase the label
1032 DO k = 1, ndim
1033 CALL uppercase(colvar%mindist_param%k_coord_to(k))
1034 END DO
1035 END IF
1036
1037 CALL section_vals_val_get(mindist_section, "R0", r_val=colvar%mindist_param%r_cut)
1038 CALL section_vals_val_get(mindist_section, "NN", i_val=colvar%mindist_param%p_exp)
1039 CALL section_vals_val_get(mindist_section, "ND", i_val=colvar%mindist_param%q_exp)
1040! CALL section_vals_val_get(mindist_section,"NC",r_val=colvar%mindist_param%n_cut)
1041 CALL section_vals_val_get(mindist_section, "LAMBDA", r_val=colvar%mindist_param%lambda)
1042 ELSE IF (my_subsection(24)) THEN
1043 ! Distance carboxylic acid and hydronium
1044 CALL colvar_create(colvar, acid_hyd_dist_colvar_id)
1045 NULLIFY (colvar%acid_hyd_dist_param%i_oxygens_water)
1046 NULLIFY (colvar%acid_hyd_dist_param%i_oxygens_acid)
1047 NULLIFY (colvar%acid_hyd_dist_param%i_hydrogens)
1048 CALL read_acid_hydronium_colvars(acid_hyd_dist_section, colvar, acid_hyd_dist_colvar_id, &
1049 colvar%acid_hyd_dist_param%n_oxygens_water, &
1050 colvar%acid_hyd_dist_param%n_oxygens_acid, &
1051 colvar%acid_hyd_dist_param%n_hydrogens, &
1052 colvar%acid_hyd_dist_param%i_oxygens_water, &
1053 colvar%acid_hyd_dist_param%i_oxygens_acid, &
1054 colvar%acid_hyd_dist_param%i_hydrogens)
1055 ELSE IF (my_subsection(25)) THEN
1056 ! Number of oxygens in 1st shell of hydronium for carboxylic acid / water system
1057 CALL colvar_create(colvar, acid_hyd_shell_colvar_id)
1058 NULLIFY (colvar%acid_hyd_shell_param%i_oxygens_water)
1059 NULLIFY (colvar%acid_hyd_shell_param%i_oxygens_acid)
1060 NULLIFY (colvar%acid_hyd_shell_param%i_hydrogens)
1061 CALL read_acid_hydronium_colvars(acid_hyd_shell_section, colvar, acid_hyd_shell_colvar_id, &
1062 colvar%acid_hyd_shell_param%n_oxygens_water, &
1063 colvar%acid_hyd_shell_param%n_oxygens_acid, &
1064 colvar%acid_hyd_shell_param%n_hydrogens, &
1065 colvar%acid_hyd_shell_param%i_oxygens_water, &
1066 colvar%acid_hyd_shell_param%i_oxygens_acid, &
1067 colvar%acid_hyd_shell_param%i_hydrogens)
1068 ELSE IF (my_subsection(26)) THEN
1069 ! Distance hydronium and hydroxide, autoionization of water
1070 CALL colvar_create(colvar, hydronium_dist_colvar_id)
1071 NULLIFY (colvar%hydronium_dist_param%i_oxygens)
1072 NULLIFY (colvar%hydronium_dist_param%i_hydrogens)
1073 CALL read_hydronium_colvars(hydronium_dist_section, colvar, hydronium_dist_colvar_id, &
1074 colvar%hydronium_dist_param%n_oxygens, &
1075 colvar%hydronium_dist_param%n_hydrogens, &
1076 colvar%hydronium_dist_param%i_oxygens, &
1077 colvar%hydronium_dist_param%i_hydrogens)
1078 ELSE IF (my_subsection(27)) THEN
1079 CALL colvar_create(colvar, voronoiipz_colvar_id)
1080 cpassert(ASSOCIATED(voronoiipz_section))
1081 CALL read_voronoiipz_colvars(voronoiipz_section, colvar)
1082 END IF
1083 CALL colvar_setup(colvar)
1084
1085 iw = cp_print_key_unit_nr(logger, colvar_section, &
1086 "PRINT%PROGRAM_RUN_INFO", extension=".colvarLog")
1087 IF (iw > 0) THEN
1088 tag = "ATOMS: "
1089 IF (colvar%use_points) tag = "POINTS:"
1090 ! Description header
1091 IF (colvar%type_id /= combine_colvar_id) THEN
1092 WRITE (iw, '( A )') ' '// &
1093 '----------------------------------------------------------------------'
1094 WRITE (iw, '( A,I8)') ' COLVARS| COLVAR INPUT INDEX: ', icol
1095 END IF
1096 ! Colvar Description
1097 SELECT CASE (colvar%type_id)
1098 CASE (angle_colvar_id)
1099 WRITE (iw, '( A,T57,3I8)') ' COLVARS| ANGLE >>> '//tag, &
1100 colvar%angle_param%i_at_angle
1101 CASE (dfunct_colvar_id)
1102 WRITE (iw, '( A,T49,4I8)') ' COLVARS| DISTANCE DIFFERENCE >>> '//tag, &
1103 colvar%dfunct_param%i_at_dfunct
1104 CASE (plane_distance_colvar_id)
1105 WRITE (iw, '( A,T57,3I8)') ' COLVARS| PLANE DISTANCE - PLANE >>> '//tag, &
1106 colvar%plane_distance_param%plane
1107 WRITE (iw, '( A,T73,1I8)') ' COLVARS| PLANE DISTANCE - POINT >>> '//tag, &
1108 colvar%plane_distance_param%point
1109 CASE (plane_plane_angle_colvar_id)
1110 IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) THEN
1111 WRITE (iw, '( A,T57,3I8)') ' COLVARS| PLANE-PLANE ANGLE - PLANE 1 (ATOMS) >>> '//tag, &
1112 colvar%plane_plane_angle_param%plane1%points
1113 ELSE
1114 WRITE (iw, '( A,T57,3F8.3)') ' COLVARS| PLANE-PLANE ANGLE - PLANE 1 (VECTOR) >>> '//tag, &
1115 colvar%plane_plane_angle_param%plane1%normal_vec
1116 END IF
1117
1118 IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) THEN
1119 WRITE (iw, '( A,T57,3I8)') ' COLVARS| PLANE-PLANE ANGLE - PLANE 1 (ATOMS) >>> '//tag, &
1120 colvar%plane_plane_angle_param%plane2%points
1121 ELSE
1122 WRITE (iw, '( A,T57,3F8.3)') ' COLVARS| PLANE-PLANE ANGLE - PLANE 1 (VECTOR) >>> '//tag, &
1123 colvar%plane_plane_angle_param%plane2%normal_vec
1124 END IF
1125 CASE (torsion_colvar_id)
1126 WRITE (iw, '( A,T49,4I8)') ' COLVARS| TORSION >>> '//tag, &
1127 colvar%torsion_param%i_at_tors
1128 CASE (dist_colvar_id)
1129 WRITE (iw, '( A,T65,2I8)') ' COLVARS| BOND >>> '//tag, &
1130 colvar%dist_param%i_at, colvar%dist_param%j_at
1131 CASE (coord_colvar_id)
1132 IF (colvar%coord_param%do_chain) THEN
1133 WRITE (iw, '( A)') ' COLVARS| COORDINATION CHAIN FC(from->to)*FC(to->to_B)>> '
1134 END IF
1135 IF (colvar%coord_param%use_kinds_from) THEN
1136 WRITE (iw, '( A,T71,A10)') (' COLVARS| COORDINATION >>> FROM KINDS', &
1137 adjustr(colvar%coord_param%c_kinds_from(kk) (1:10)), &
1138 kk=1, SIZE(colvar%coord_param%c_kinds_from))
1139 ELSE
1140 WRITE (iw, '( A,T71,I10)') (' COLVARS| COORDINATION >>> FROM '//tag, &
1141 colvar%coord_param%i_at_from(kk), &
1142 kk=1, SIZE(colvar%coord_param%i_at_from))
1143 END IF
1144 IF (colvar%coord_param%use_kinds_to) THEN
1145 WRITE (iw, '( A,T71,A10)') (' COLVARS| COORDINATION >>> TO KINDS', &
1146 adjustr(colvar%coord_param%c_kinds_to(kk) (1:10)), &
1147 kk=1, SIZE(colvar%coord_param%c_kinds_to))
1148 ELSE
1149 WRITE (iw, '( A,T71,I10)') (' COLVARS| COORDINATION >>> TO '//tag, &
1150 colvar%coord_param%i_at_to(kk), &
1151 kk=1, SIZE(colvar%coord_param%i_at_to))
1152 END IF
1153 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| R0', colvar%coord_param%r_0
1154 WRITE (iw, '( A,T71,I10)') ' COLVARS| NN', colvar%coord_param%nncrd
1155 WRITE (iw, '( A,T71,I10)') ' COLVARS| ND', colvar%coord_param%ndcrd
1156 IF (colvar%coord_param%do_chain) THEN
1157 IF (colvar%coord_param%use_kinds_to_b) THEN
1158 WRITE (iw, '( A,T71,A10)') (' COLVARS| COORDINATION >>> TO KINDS B', &
1159 adjustr(colvar%coord_param%c_kinds_to_b(kk) (1:10)), &
1160 kk=1, SIZE(colvar%coord_param%c_kinds_to_b))
1161 ELSE
1162 WRITE (iw, '( A,T71,I10)') (' COLVARS| COORDINATION >>> TO '//tag//' B', &
1163 colvar%coord_param%i_at_to_b(kk), &
1164 kk=1, SIZE(colvar%coord_param%i_at_to_b))
1165 END IF
1166 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| R0 B', colvar%coord_param%r_0_b
1167 WRITE (iw, '( A,T71,I10)') ' COLVARS| NN B', colvar%coord_param%nncrd_b
1168 WRITE (iw, '( A,T71,I10)') ' COLVARS| ND B', colvar%coord_param%ndcrd_b
1169 END IF
1170 CASE (population_colvar_id)
1171 IF (colvar%population_param%use_kinds_from) THEN
1172 WRITE (iw, '( A,T71,A10)') (' COLVARS| POPULATION based on coordination >>> FROM KINDS', &
1173 adjustr(colvar%population_param%c_kinds_from(kk) (1:10)), &
1174 kk=1, SIZE(colvar%population_param%c_kinds_from))
1175 ELSE
1176 WRITE (iw, '( A,T71,I10)') (' COLVARS| POPULATION based on coordination >>> FROM '//tag, &
1177 colvar%population_param%i_at_from(kk), &
1178 kk=1, SIZE(colvar%population_param%i_at_from))
1179 END IF
1180 IF (colvar%population_param%use_kinds_to) THEN
1181 WRITE (iw, '( A,T71,A10)') (' COLVARS| POPULATION based on coordination >>> TO KINDS', &
1182 adjustr(colvar%population_param%c_kinds_to(kk) (1:10)), &
1183 kk=1, SIZE(colvar%population_param%c_kinds_to))
1184 ELSE
1185 WRITE (iw, '( A,T71,I10)') (' COLVARS| POPULATION based on coordination >>> TO '//tag, &
1186 colvar%population_param%i_at_to(kk), &
1187 kk=1, SIZE(colvar%population_param%i_at_to))
1188 END IF
1189 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| R0', colvar%population_param%r_0
1190 WRITE (iw, '( A,T71,I10)') ' COLVARS| NN', colvar%population_param%nncrd
1191 WRITE (iw, '( A,T71,I10)') ' COLVARS| ND', colvar%population_param%ndcrd
1192 WRITE (iw, '( A,T71,I10)') ' COLVARS| N0', colvar%population_param%n0
1193 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| SIGMA', colvar%population_param%sigma
1194 CASE (gyration_colvar_id)
1195 IF (colvar%gyration_param%use_kinds) THEN
1196 WRITE (iw, '( A,T71,A10)') (' COLVARS| Gyration Radius >>> KINDS', &
1197 adjustr(colvar%gyration_param%c_kinds(kk) (1:10)), &
1198 kk=1, SIZE(colvar%gyration_param%c_kinds))
1199 ELSE
1200 WRITE (iw, '( A,T71,I10)') (' COLVARS| Gyration Radius >>> ATOMS '//tag, &
1201 colvar%gyration_param%i_at(kk), &
1202 kk=1, SIZE(colvar%gyration_param%i_at))
1203 END IF
1204 CASE (rotation_colvar_id)
1205 WRITE (iw, '( A,T71,I10)') ' COLVARS| BOND_ROTATION - POINT 1 LINE 1 >>> '//tag, &
1206 colvar%rotation_param%i_at1_bond1
1207 WRITE (iw, '( A,T71,I10)') ' COLVARS| BOND_ROTATION - POINT 2 LINE 1 >>> '//tag, &
1208 colvar%rotation_param%i_at2_bond1
1209 WRITE (iw, '( A,T71,I10)') ' COLVARS| BOND_ROTATION - POINT 1 LINE 2 >>> '//tag, &
1210 colvar%rotation_param%i_at1_bond2
1211 WRITE (iw, '( A,T71,I10)') ' COLVARS| BOND_ROTATION - POINT 2 LINE 2 >>> '//tag, &
1212 colvar%rotation_param%i_at2_bond2
1213 CASE (qparm_colvar_id)
1214 WRITE (iw, '( A,T71,I10)') (' COLVARS| Q-PARM >>> FROM '//tag, &
1215 colvar%qparm_param%i_at_from(kk), &
1216 kk=1, SIZE(colvar%qparm_param%i_at_from))
1217 WRITE (iw, '( A,T71,I10)') (' COLVARS| Q-PARM >>> TO '//tag, &
1218 colvar%qparm_param%i_at_to(kk), &
1219 kk=1, SIZE(colvar%qparm_param%i_at_to))
1220 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| RCUT', colvar%qparm_param%rcut
1221 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| RSTART', colvar%qparm_param%rstart
1222 WRITE (iw, '( A,T71,L10)') ' COLVARS| INCLUDE IMAGES', colvar%qparm_param%include_images
1223 !WRITE (iw, '( A,T71,F10.5)') ' COLVARS| ALPHA', colvar%qparm_param%alpha
1224 WRITE (iw, '( A,T71,I10)') ' COLVARS| L', colvar%qparm_param%l
1225 CASE (combine_colvar_id)
1226 WRITE (iw, '( A)') ' COLVARS| COMBINING FUNCTION : '// &
1227 trim(colvar%combine_cvs_param%function)
1228 WRITE (iw, '( A)', advance="NO") ' COLVARS| VARIABLES : '
1229 DO i = 1, SIZE(colvar%combine_cvs_param%variables)
1230 WRITE (iw, '( A)', advance="NO") &
1231 trim(colvar%combine_cvs_param%variables(i))//" "
1232 END DO
1233 WRITE (iw, '(/)')
1234 WRITE (iw, '( A)') ' COLVARS| DEFINED PARAMETERS [label] [value]:'
1235 DO i = 1, SIZE(colvar%combine_cvs_param%c_parameters)
1236 WRITE (iw, '( A,A7,F9.3)') ' ', &
1237 trim(colvar%combine_cvs_param%c_parameters(i)), colvar%combine_cvs_param%v_parameters(i)
1238 END DO
1239 WRITE (iw, '( A,T71,G10.5)') ' COLVARS| ERROR ON DERIVATIVE EVALUATION', &
1240 colvar%combine_cvs_param%lerr
1241 WRITE (iw, '( A,T71,G10.5)') ' COLVARS| DX', &
1242 colvar%combine_cvs_param%dx
1243 CASE (reaction_path_colvar_id)
1244 cpwarn("Description header for REACTION_PATH COLVAR missing!")
1245 CASE (distance_from_path_colvar_id)
1246 cpwarn("Description header for REACTION_PATH COLVAR missing!")
1247 CASE (hydronium_shell_colvar_id)
1248 WRITE (iw, '( A,T71,I10)') ' COLVARS| POH', colvar%hydronium_shell_param%poh
1249 WRITE (iw, '( A,T71,I10)') ' COLVARS| QOH', colvar%hydronium_shell_param%qoh
1250 WRITE (iw, '( A,T71,I10)') ' COLVARS| POO', colvar%hydronium_shell_param%poo
1251 WRITE (iw, '( A,T71,I10)') ' COLVARS| QOO', colvar%hydronium_shell_param%qoo
1252 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| ROO', colvar%hydronium_shell_param%roo
1253 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| ROH', colvar%hydronium_shell_param%roh
1254 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| NH', colvar%hydronium_shell_param%nh
1255 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| LAMBDA', colvar%hydronium_shell_param%lambda
1256 CASE (hydronium_dist_colvar_id)
1257 WRITE (iw, '( A,T71,I10)') ' COLVARS| POH', colvar%hydronium_dist_param%poh
1258 WRITE (iw, '( A,T71,I10)') ' COLVARS| QOH', colvar%hydronium_dist_param%qoh
1259 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| ROH', colvar%hydronium_dist_param%roh
1260 WRITE (iw, '( A,T71,I10)') ' COLVARS| PM', colvar%hydronium_dist_param%pm
1261 WRITE (iw, '( A,T71,I10)') ' COLVARS| QM', colvar%hydronium_dist_param%qm
1262 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| NH', colvar%hydronium_dist_param%nh
1263 WRITE (iw, '( A,T71,I10)') ' COLVARS| PF', colvar%hydronium_dist_param%pf
1264 WRITE (iw, '( A,T71,I10)') ' COLVARS| QF', colvar%hydronium_dist_param%qf
1265 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| NN', colvar%hydronium_dist_param%nn
1266 CASE (acid_hyd_dist_colvar_id)
1267 WRITE (iw, '( A,T71,I10)') ' COLVARS| PAOH', colvar%acid_hyd_dist_param%paoh
1268 WRITE (iw, '( A,T71,I10)') ' COLVARS| QAOH', colvar%acid_hyd_dist_param%qaoh
1269 WRITE (iw, '( A,T71,I10)') ' COLVARS| PWOH', colvar%acid_hyd_dist_param%pwoh
1270 WRITE (iw, '( A,T71,I10)') ' COLVARS| QWOH', colvar%acid_hyd_dist_param%qwoh
1271 WRITE (iw, '( A,T71,I10)') ' COLVARS| PCUT', colvar%acid_hyd_dist_param%pcut
1272 WRITE (iw, '( A,T71,I10)') ' COLVARS| QCUT', colvar%acid_hyd_dist_param%qcut
1273 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| RAOH', colvar%acid_hyd_dist_param%raoh
1274 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| RWOH', colvar%acid_hyd_dist_param%rwoh
1275 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| NC', colvar%acid_hyd_dist_param%nc
1276 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| LAMBDA', colvar%acid_hyd_dist_param%lambda
1277 CASE (acid_hyd_shell_colvar_id)
1278 WRITE (iw, '( A,T71,I10)') ' COLVARS| PAOH', colvar%acid_hyd_shell_param%paoh
1279 WRITE (iw, '( A,T71,I10)') ' COLVARS| QAOH', colvar%acid_hyd_shell_param%qaoh
1280 WRITE (iw, '( A,T71,I10)') ' COLVARS| PWOH', colvar%acid_hyd_shell_param%pwoh
1281 WRITE (iw, '( A,T71,I10)') ' COLVARS| QWOH', colvar%acid_hyd_shell_param%qwoh
1282 WRITE (iw, '( A,T71,I10)') ' COLVARS| POO', colvar%acid_hyd_shell_param%poo
1283 WRITE (iw, '( A,T71,I10)') ' COLVARS| QOO', colvar%acid_hyd_shell_param%qoo
1284 WRITE (iw, '( A,T71,I10)') ' COLVARS| PM', colvar%acid_hyd_shell_param%pm
1285 WRITE (iw, '( A,T71,I10)') ' COLVARS| QM', colvar%acid_hyd_shell_param%qm
1286 WRITE (iw, '( A,T71,I10)') ' COLVARS| PCUT', colvar%acid_hyd_shell_param%pcut
1287 WRITE (iw, '( A,T71,I10)') ' COLVARS| QCUT', colvar%acid_hyd_shell_param%qcut
1288 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| RAOH', colvar%acid_hyd_shell_param%raoh
1289 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| RWOH', colvar%acid_hyd_shell_param%rwoh
1290 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| ROO', colvar%acid_hyd_shell_param%roo
1291 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| NH', colvar%acid_hyd_shell_param%nh
1292 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| NC', colvar%acid_hyd_shell_param%nc
1293 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| LAMBDA', colvar%acid_hyd_shell_param%lambda
1294 CASE (rmsd_colvar_id)
1295 cpwarn("Description header for RMSD COLVAR missing!")
1296 CASE (xyz_diag_colvar_id)
1297 NULLIFY (section, keyword, enum)
1298 CALL create_colvar_xyz_d_section(section)
1299 keyword => section_get_keyword(section, "COMPONENT")
1300 CALL keyword_get(keyword, enum=enum)
1301 tag_comp = trim(enum_i2c(enum, colvar%xyz_diag_param%component))
1302 CALL section_release(section)
1303
1304 WRITE (iw, '( A,T57,3I8)') ' COLVARS| POSITION ('//trim(tag_comp) &
1305 //') >>> '//tag, colvar%xyz_diag_param%i_atom
1306 CASE (xyz_outerdiag_colvar_id)
1307 NULLIFY (section, keyword, enum)
1308 CALL create_colvar_xyz_od_section(section)
1309 keyword => section_get_keyword(section, "COMPONENT_A")
1310 CALL keyword_get(keyword, enum=enum)
1311 tag_comp1 = trim(enum_i2c(enum, colvar%xyz_outerdiag_param%components(1)))
1312 keyword => section_get_keyword(section, "COMPONENT_B")
1313 CALL keyword_get(keyword, enum=enum)
1314 tag_comp2 = trim(enum_i2c(enum, colvar%xyz_outerdiag_param%components(2)))
1315 CALL section_release(section)
1316
1317 WRITE (iw, '( A,T57,3I8)') ' COLVARS| CROSS TERM POSITION ('//trim(tag_comp1) &
1318 //" * "//trim(tag_comp2)//') >>> '//tag, colvar%xyz_outerdiag_param%i_atoms
1319 CASE (u_colvar_id)
1320 WRITE (iw, '( A,T77,A4)') ' COLVARS| ENERGY >>> '//tag, 'all!'
1321 CASE (wc_colvar_id)
1322 WRITE (iw, '( A,T57,F16.8)') ' COLVARS| Wc >>> RCUT: ', &
1323 colvar%Wc%rcut
1324 WRITE (iw, '( A,T57,3I8)') ' COLVARS| Wc >>> '//tag, &
1325 colvar%Wc%ids
1326 CASE (hbp_colvar_id)
1327 WRITE (iw, '( A,T57,I8)') ' COLVARS| HBP >>> NPOINTS', &
1328 colvar%HBP%nPoints
1329 WRITE (iw, '( A,T57,F16.8)') ' COLVARS| HBP >>> RCUT', &
1330 colvar%HBP%rcut
1331 WRITE (iw, '( A,T57,F16.8)') ' COLVARS| HBP >>> RCUT', &
1332 colvar%HBP%shift
1333 DO i = 1, colvar%HBP%nPoints
1334 WRITE (iw, '( A,T57,3I8)') ' COLVARS| HBP >>> '//tag, &
1335 colvar%HBP%ids(i, :)
1336 END DO
1337 CASE (ring_puckering_colvar_id)
1338 WRITE (iw, '( A,T57,I8)') ' COLVARS| Ring Puckering >>> ring size', &
1339 colvar%ring_puckering_param%nring
1340 IF (colvar%ring_puckering_param%iq == 0) THEN
1341 WRITE (iw, '( A,T40,A)') ' COLVARS| Ring Puckering >>> coordinate', &
1342 ' Total Puckering Amplitude'
1343 ELSE IF (colvar%ring_puckering_param%iq > 0) THEN
1344 WRITE (iw, '( A,T35,A,T57,I8)') ' COLVARS| Ring Puckering >>> coordinate', &
1345 ' Puckering Amplitude', &
1346 colvar%ring_puckering_param%iq
1347 ELSE
1348 WRITE (iw, '( A,T35,A,T57,I8)') ' COLVARS| Ring Puckering >>> coordinate', &
1349 ' Puckering Angle', &
1350 colvar%ring_puckering_param%iq
1351 END IF
1352 CASE (mindist_colvar_id)
1353 WRITE (iw, '( A)') ' COLVARS| CONDITIONED DISTANCE>> '
1354 WRITE (iw, '( A,T71,I10)') (' COLVARS| COND.DISTANCE >>> DISTANCE FROM '//tag, &
1355 colvar%mindist_param%i_dist_from(kk), &
1356 kk=1, SIZE(colvar%mindist_param%i_dist_from))
1357 IF (colvar%mindist_param%use_kinds_from) THEN
1358 WRITE (iw, '( A,T71,A10)') (' COLVARS| COND.DIST. >>> COORDINATION FROM KINDS ', &
1359 adjustr(colvar%mindist_param%k_coord_from(kk) (1:10)), &
1360 kk=1, SIZE(colvar%mindist_param%k_coord_from))
1361 ELSE
1362 WRITE (iw, '( A,T71,I10)') (' COLVARS| COND.DIST. >>> COORDINATION FROM '//tag, &
1363 colvar%mindist_param%i_coord_from(kk), &
1364 kk=1, SIZE(colvar%mindist_param%i_coord_from))
1365 END IF
1366 IF (colvar%mindist_param%use_kinds_to) THEN
1367 WRITE (iw, '( A,T71,A10)') (' COLVARS| COND.DIST. >>> COORDINATION TO KINDS ', &
1368 adjustr(colvar%mindist_param%k_coord_to(kk) (1:10)), &
1369 kk=1, SIZE(colvar%mindist_param%k_coord_to))
1370 ELSE
1371 WRITE (iw, '( A,T71,I10)') (' COLVARS| COND.DIST. >>> COORDINATION TO '//tag, &
1372 colvar%mindist_param%i_coord_to(kk), &
1373 kk=1, SIZE(colvar%mindist_param%i_coord_to))
1374 END IF
1375 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| R0', colvar%mindist_param%r_cut
1376 WRITE (iw, '( A,T71,I10)') ' COLVARS| NN', colvar%mindist_param%p_exp
1377 WRITE (iw, '( A,T71,I10)') ' COLVARS| ND', colvar%mindist_param%q_exp
1378 WRITE (iw, '( A,T71,F10.5)') ' COLVARS| LAMBDA', colvar%mindist_param%lambda
1379
1380 END SELECT
1381 IF (colvar%use_points) THEN
1382 WRITE (iw, '( A)') ' COLVARS| INFORMATION ON DEFINED GEOMETRICAL POINTS'
1383 DO kk = 1, SIZE(colvar%points)
1384 point_section => section_vals_get_subs_vals(wrk_section, "POINT")
1385 CALL section_vals_val_get(point_section, "TYPE", i_rep_section=kk, c_val=tmpstr)
1386 tmpstr2 = cp_to_string(kk)
1387 WRITE (iw, '( A)') ' COLVARS| POINT Nr.'//trim(tmpstr2)//' OF TYPE: '//trim(tmpstr)
1388 IF (ASSOCIATED(colvar%points(kk)%atoms)) THEN
1389 WRITE (iw, '( A)') ' COLVARS| ATOMS BUILDING THE GEOMETRICAL POINT'
1390 WRITE (iw, '( A, I10)') (' COLVARS| ATOM:', colvar%points(kk)%atoms(k), k=1, SIZE(colvar%points(kk)%atoms))
1391 ELSE
1392 WRITE (iw, '( A,4X,3F12.6)') ' COLVARS| XYZ POSITION OF FIXED POINT:', colvar%points(kk)%r
1393 END IF
1394 END DO
1395 END IF
1396 ! Close the description layer
1397 IF (colvar%type_id /= combine_colvar_id) THEN
1398 WRITE (iw, '( A )') ' '// &
1399 '----------------------------------------------------------------------'
1400 ELSE
1401 WRITE (iw, '( A )') ' '// &
1402 '**********************************************************************'
1403 END IF
1404 END IF
1405 CALL cp_print_key_finished_output(iw, logger, colvar_section, &
1406 "PRINT%PROGRAM_RUN_INFO")
1407 CALL timestop(handle)
1408 END SUBROUTINE colvar_read
1409
1410! **************************************************************************************************
1411!> \brief read collective variables for the autoionization of water
1412!> \param section ...
1413!> \param colvar collective variable
1414!> \param colvar_id ...
1415!> \param n_oxygens number of oxygens
1416!> \param n_hydrogens number of hydrogens
1417!> \param i_oxygens list of oxygens
1418!> \param i_hydrogens list of hydrogens
1419!> \author Dorothea Golze
1420! **************************************************************************************************
1421 SUBROUTINE read_hydronium_colvars(section, colvar, colvar_id, n_oxygens, n_hydrogens, &
1422 i_oxygens, i_hydrogens)
1423 TYPE(section_vals_type), POINTER :: section
1424 TYPE(colvar_type), POINTER :: colvar
1425 INTEGER, INTENT(IN) :: colvar_id
1426 INTEGER, INTENT(OUT) :: n_oxygens, n_hydrogens
1427 INTEGER, DIMENSION(:), POINTER :: i_oxygens, i_hydrogens
1428
1429 INTEGER :: k, n_var, ndim
1430 INTEGER, DIMENSION(:), POINTER :: iatms
1431
1432 NULLIFY (iatms)
1433
1434 CALL section_vals_val_get(section, "OXYGENS", n_rep_val=n_var)
1435 ndim = 0
1436 DO k = 1, n_var
1437 CALL section_vals_val_get(section, "OXYGENS", i_rep_val=k, i_vals=iatms)
1438 CALL reallocate(i_oxygens, 1, ndim + SIZE(iatms))
1439 i_oxygens(ndim + 1:ndim + SIZE(iatms)) = iatms
1440 ndim = ndim + SIZE(iatms)
1441 END DO
1442 n_oxygens = ndim
1443
1444 CALL section_vals_val_get(section, "HYDROGENS", n_rep_val=n_var)
1445 ndim = 0
1446 DO k = 1, n_var
1447 CALL section_vals_val_get(section, "HYDROGENS", i_rep_val=k, i_vals=iatms)
1448 CALL reallocate(i_hydrogens, 1, ndim + SIZE(iatms))
1449 i_hydrogens(ndim + 1:ndim + SIZE(iatms)) = iatms
1450 ndim = ndim + SIZE(iatms)
1451 END DO
1452 n_hydrogens = ndim
1453
1454 SELECT CASE (colvar_id)
1455 CASE (hydronium_shell_colvar_id)
1456 CALL section_vals_val_get(section, "ROO", r_val=colvar%hydronium_shell_param%roo)
1457 CALL section_vals_val_get(section, "ROH", r_val=colvar%hydronium_shell_param%roh)
1458 CALL section_vals_val_get(section, "pOH", i_val=colvar%hydronium_shell_param%poh)
1459 CALL section_vals_val_get(section, "qOH", i_val=colvar%hydronium_shell_param%qoh)
1460 CALL section_vals_val_get(section, "pOO", i_val=colvar%hydronium_shell_param%poo)
1461 CALL section_vals_val_get(section, "qOO", i_val=colvar%hydronium_shell_param%qoo)
1462 CALL section_vals_val_get(section, "pM", i_val=colvar%hydronium_shell_param%pm)
1463 CALL section_vals_val_get(section, "qM", i_val=colvar%hydronium_shell_param%qm)
1464 CALL section_vals_val_get(section, "NH", r_val=colvar%hydronium_shell_param%nh)
1465 CALL section_vals_val_get(section, "LAMBDA", r_val=colvar%hydronium_shell_param%lambda)
1466 CASE (hydronium_dist_colvar_id)
1467 CALL section_vals_val_get(section, "ROH", r_val=colvar%hydronium_dist_param%roh)
1468 CALL section_vals_val_get(section, "pOH", i_val=colvar%hydronium_dist_param%poh)
1469 CALL section_vals_val_get(section, "qOH", i_val=colvar%hydronium_dist_param%qoh)
1470 CALL section_vals_val_get(section, "pF", i_val=colvar%hydronium_dist_param%pf)
1471 CALL section_vals_val_get(section, "qF", i_val=colvar%hydronium_dist_param%qf)
1472 CALL section_vals_val_get(section, "pM", i_val=colvar%hydronium_dist_param%pm)
1473 CALL section_vals_val_get(section, "qM", i_val=colvar%hydronium_dist_param%qm)
1474 CALL section_vals_val_get(section, "NH", r_val=colvar%hydronium_dist_param%nh)
1475 CALL section_vals_val_get(section, "NN", r_val=colvar%hydronium_dist_param%nn)
1476 CALL section_vals_val_get(section, "LAMBDA", r_val=colvar%hydronium_dist_param%lambda)
1477 END SELECT
1478
1479 END SUBROUTINE read_hydronium_colvars
1480
1481! **************************************************************************************************
1482!> \brief read collective variables for the dissociation of a carboxylic acid
1483!> in water
1484!> \param section ...
1485!> \param colvar collective variable
1486!> \param colvar_id ...
1487!> \param n_oxygens_water number of oxygens of water molecules
1488!> \param n_oxygens_acid number of oxgyens of carboxyl groups
1489!> \param n_hydrogens number of hydrogens (water and carboxyl group)
1490!> \param i_oxygens_water list of oxygens of water molecules
1491!> \param i_oxygens_acid list of oxygens of carboxyl group
1492!> \param i_hydrogens list of hydrogens (water and carboxyl group)
1493!> \author Dorothea Golze
1494! **************************************************************************************************
1495 SUBROUTINE read_acid_hydronium_colvars(section, colvar, colvar_id, n_oxygens_water, &
1496 n_oxygens_acid, n_hydrogens, i_oxygens_water, &
1497 i_oxygens_acid, i_hydrogens)
1498 TYPE(section_vals_type), POINTER :: section
1499 TYPE(colvar_type), POINTER :: colvar
1500 INTEGER, INTENT(IN) :: colvar_id
1501 INTEGER, INTENT(OUT) :: n_oxygens_water, n_oxygens_acid, &
1502 n_hydrogens
1503 INTEGER, DIMENSION(:), POINTER :: i_oxygens_water, i_oxygens_acid, &
1504 i_hydrogens
1505
1506 INTEGER :: k, n_var, ndim
1507 INTEGER, DIMENSION(:), POINTER :: iatms
1508
1509 NULLIFY (iatms)
1510
1511 CALL section_vals_val_get(section, "OXYGENS_WATER", n_rep_val=n_var)
1512 ndim = 0
1513 DO k = 1, n_var
1514 CALL section_vals_val_get(section, "OXYGENS_WATER", i_rep_val=k, i_vals=iatms)
1515 CALL reallocate(i_oxygens_water, 1, ndim + SIZE(iatms))
1516 i_oxygens_water(ndim + 1:ndim + SIZE(iatms)) = iatms
1517 ndim = ndim + SIZE(iatms)
1518 END DO
1519 n_oxygens_water = ndim
1520
1521 CALL section_vals_val_get(section, "OXYGENS_ACID", n_rep_val=n_var)
1522 ndim = 0
1523 DO k = 1, n_var
1524 CALL section_vals_val_get(section, "OXYGENS_ACID", i_rep_val=k, i_vals=iatms)
1525 CALL reallocate(i_oxygens_acid, 1, ndim + SIZE(iatms))
1526 i_oxygens_acid(ndim + 1:ndim + SIZE(iatms)) = iatms
1527 ndim = ndim + SIZE(iatms)
1528 END DO
1529 n_oxygens_acid = ndim
1530
1531 CALL section_vals_val_get(section, "HYDROGENS", n_rep_val=n_var)
1532 ndim = 0
1533 DO k = 1, n_var
1534 CALL section_vals_val_get(section, "HYDROGENS", i_rep_val=k, i_vals=iatms)
1535 CALL reallocate(i_hydrogens, 1, ndim + SIZE(iatms))
1536 i_hydrogens(ndim + 1:ndim + SIZE(iatms)) = iatms
1537 ndim = ndim + SIZE(iatms)
1538 END DO
1539 n_hydrogens = ndim
1540
1541 SELECT CASE (colvar_id)
1542 CASE (acid_hyd_dist_colvar_id)
1543 CALL section_vals_val_get(section, "pWOH", i_val=colvar%acid_hyd_dist_param%pwoh)
1544 CALL section_vals_val_get(section, "qWOH", i_val=colvar%acid_hyd_dist_param%qwoh)
1545 CALL section_vals_val_get(section, "pAOH", i_val=colvar%acid_hyd_dist_param%paoh)
1546 CALL section_vals_val_get(section, "qAOH", i_val=colvar%acid_hyd_dist_param%qaoh)
1547 CALL section_vals_val_get(section, "pCUT", i_val=colvar%acid_hyd_dist_param%pcut)
1548 CALL section_vals_val_get(section, "qCUT", i_val=colvar%acid_hyd_dist_param%qcut)
1549 CALL section_vals_val_get(section, "RWOH", r_val=colvar%acid_hyd_dist_param%rwoh)
1550 CALL section_vals_val_get(section, "RAOH", r_val=colvar%acid_hyd_dist_param%raoh)
1551 CALL section_vals_val_get(section, "NC", r_val=colvar%acid_hyd_dist_param%nc)
1552 CALL section_vals_val_get(section, "LAMBDA", r_val=colvar%acid_hyd_dist_param%lambda)
1553 CASE (acid_hyd_shell_colvar_id)
1554 CALL section_vals_val_get(section, "pWOH", i_val=colvar%acid_hyd_shell_param%pwoh)
1555 CALL section_vals_val_get(section, "qWOH", i_val=colvar%acid_hyd_shell_param%qwoh)
1556 CALL section_vals_val_get(section, "pAOH", i_val=colvar%acid_hyd_shell_param%paoh)
1557 CALL section_vals_val_get(section, "qAOH", i_val=colvar%acid_hyd_shell_param%qaoh)
1558 CALL section_vals_val_get(section, "pOO", i_val=colvar%acid_hyd_shell_param%poo)
1559 CALL section_vals_val_get(section, "qOO", i_val=colvar%acid_hyd_shell_param%qoo)
1560 CALL section_vals_val_get(section, "pM", i_val=colvar%acid_hyd_shell_param%pm)
1561 CALL section_vals_val_get(section, "qM", i_val=colvar%acid_hyd_shell_param%qm)
1562 CALL section_vals_val_get(section, "pCUT", i_val=colvar%acid_hyd_shell_param%pcut)
1563 CALL section_vals_val_get(section, "qCUT", i_val=colvar%acid_hyd_shell_param%qcut)
1564 CALL section_vals_val_get(section, "RWOH", r_val=colvar%acid_hyd_shell_param%rwoh)
1565 CALL section_vals_val_get(section, "RAOH", r_val=colvar%acid_hyd_shell_param%raoh)
1566 CALL section_vals_val_get(section, "ROO", r_val=colvar%acid_hyd_shell_param%roo)
1567 CALL section_vals_val_get(section, "NC", r_val=colvar%acid_hyd_shell_param%nc)
1568 CALL section_vals_val_get(section, "NH", r_val=colvar%acid_hyd_shell_param%nh)
1569 CALL section_vals_val_get(section, "LAMBDA", r_val=colvar%acid_hyd_shell_param%lambda)
1570 END SELECT
1571
1572 END SUBROUTINE read_acid_hydronium_colvars
1573
1574! **************************************************************************************************
1575!> \brief Check and setup about the use of geometrical points instead of atoms
1576!> \param colvar the colvat to initialize
1577!> \param section ...
1578!> \param cell ...
1579!> \author Teodoro Laino, [teo] 03.2007
1580! **************************************************************************************************
1581 SUBROUTINE colvar_check_points(colvar, section, cell)
1582 TYPE(colvar_type), POINTER :: colvar
1583 TYPE(section_vals_type), POINTER :: section
1584 TYPE(cell_type), OPTIONAL, POINTER :: cell
1585
1586 INTEGER :: i, irep, natoms, npoints, nrep, nweights
1587 INTEGER, DIMENSION(:), POINTER :: atoms
1588 LOGICAL :: explicit
1589 REAL(kind=dp), DIMENSION(:), POINTER :: r, weights
1590 TYPE(section_vals_type), POINTER :: point_sections
1591
1592 NULLIFY (point_sections)
1593 NULLIFY (atoms)
1594 NULLIFY (weights)
1595 cpassert(ASSOCIATED(colvar))
1596 point_sections => section_vals_get_subs_vals(section, "POINT")
1597 CALL section_vals_get(point_sections, explicit=explicit)
1598 IF (explicit) THEN
1599 colvar%use_points = .true.
1600 CALL section_vals_get(point_sections, n_repetition=npoints)
1601 ALLOCATE (colvar%points(npoints))
1602 ! Read points definition
1603 DO i = 1, npoints
1604 natoms = 0
1605 nweights = 0
1606 NULLIFY (colvar%points(i)%atoms)
1607 NULLIFY (colvar%points(i)%weights)
1608 CALL section_vals_val_get(point_sections, "TYPE", i_rep_section=i, i_val=colvar%points(i)%type_id)
1609 SELECT CASE (colvar%points(i)%type_id)
1610 CASE (do_clv_geo_center)
1611 ! Define a point through a list of atoms..
1612 CALL section_vals_val_get(point_sections, "ATOMS", i_rep_section=i, n_rep_val=nrep, i_vals=atoms)
1613 DO irep = 1, nrep
1614 CALL section_vals_val_get(point_sections, "ATOMS", i_rep_section=i, i_rep_val=irep, i_vals=atoms)
1615 natoms = natoms + SIZE(atoms)
1616 END DO
1617 ALLOCATE (colvar%points(i)%atoms(natoms))
1618 natoms = 0
1619 DO irep = 1, nrep
1620 CALL section_vals_val_get(point_sections, "ATOMS", i_rep_section=i, i_rep_val=irep, i_vals=atoms)
1621 colvar%points(i)%atoms(natoms + 1:) = atoms(:)
1622 natoms = natoms + SIZE(atoms)
1623 END DO
1624 ! Define weights of the list
1625 ALLOCATE (colvar%points(i)%weights(natoms))
1626 colvar%points(i)%weights = 1.0_dp/real(natoms, kind=dp)
1627 CALL section_vals_val_get(point_sections, "WEIGHTS", i_rep_section=i, n_rep_val=nrep)
1628 IF (nrep /= 0) THEN
1629 DO irep = 1, nrep
1630 CALL section_vals_val_get(point_sections, "WEIGHTS", i_rep_section=i, i_rep_val=irep, &
1631 r_vals=weights)
1632 colvar%points(i)%weights(nweights + 1:) = weights(:)
1633 nweights = nweights + SIZE(weights)
1634 END DO
1635 cpassert(natoms == nweights)
1636 END IF
1637 CASE (do_clv_fix_point)
1638 ! Define the point as a fixed point in space..
1639 CALL section_vals_val_get(point_sections, "XYZ", i_rep_section=i, r_vals=r)
1640 colvar%points(i)%r = r
1641 IF (PRESENT(cell)) THEN
1642 IF (ASSOCIATED(cell)) CALL cell_transform_input_cartesian(cell, colvar%points(i)%r)
1643 END IF
1644 END SELECT
1645 END DO
1646 END IF
1647 END SUBROUTINE colvar_check_points
1648
1649! **************************************************************************************************
1650!> \brief evaluates the derivatives (dsdr) given and due to the given colvar
1651!> variables in a molecular environment
1652!> \param colvar the collective variable to evaluate
1653!> \param cell ...
1654!> \param particles ...
1655!> \param pos ...
1656!> \param fixd_list ...
1657!> \author Teodoro Laino
1658! **************************************************************************************************
1659 SUBROUTINE colvar_eval_mol_f(colvar, cell, particles, pos, fixd_list)
1660 TYPE(colvar_type), POINTER :: colvar
1661 TYPE(cell_type), POINTER :: cell
1662 TYPE(particle_type), DIMENSION(:), POINTER :: particles
1663 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), &
1664 OPTIONAL :: pos
1665 TYPE(fixd_constraint_type), DIMENSION(:), &
1666 OPTIONAL, POINTER :: fixd_list
1667
1668 INTEGER :: i, j
1669 LOGICAL :: colvar_ok
1670
1671 colvar_ok = ASSOCIATED(colvar)
1672 cpassert(colvar_ok)
1673
1674 IF (PRESENT(pos)) THEN
1675 DO i = 1, SIZE(colvar%i_atom)
1676 j = colvar%i_atom(i)
1677 particles(j)%r = pos(:, j)
1678 END DO
1679 END IF
1680 ! Initialize the content of the derivative
1681 colvar%dsdr = 0.0_dp
1682 SELECT CASE (colvar%type_id)
1683 CASE (dist_colvar_id)
1684 CALL dist_colvar(colvar, cell, particles=particles)
1685 CASE (coord_colvar_id)
1686 CALL coord_colvar(colvar, cell, particles=particles)
1687 CASE (population_colvar_id)
1688 CALL population_colvar(colvar, cell, particles=particles)
1689 CASE (gyration_colvar_id)
1690 CALL gyration_radius_colvar(colvar, cell, particles=particles)
1691 CASE (torsion_colvar_id)
1692 CALL torsion_colvar(colvar, cell, particles=particles)
1693 CASE (angle_colvar_id)
1694 CALL angle_colvar(colvar, cell, particles=particles)
1695 CASE (dfunct_colvar_id)
1696 CALL dfunct_colvar(colvar, cell, particles=particles)
1697 CASE (plane_distance_colvar_id)
1698 CALL plane_distance_colvar(colvar, cell, particles=particles)
1699 CASE (plane_plane_angle_colvar_id)
1700 CALL plane_plane_angle_colvar(colvar, cell, particles=particles)
1701 CASE (rotation_colvar_id)
1702 CALL rotation_colvar(colvar, cell, particles=particles)
1703 CASE (qparm_colvar_id)
1704 CALL qparm_colvar(colvar, cell, particles=particles)
1705 CASE (hydronium_shell_colvar_id)
1706 CALL hydronium_shell_colvar(colvar, cell, particles=particles)
1707 CASE (hydronium_dist_colvar_id)
1708 CALL hydronium_dist_colvar(colvar, cell, particles=particles)
1709 CASE (acid_hyd_dist_colvar_id)
1710 CALL acid_hyd_dist_colvar(colvar, cell, particles=particles)
1711 CASE (acid_hyd_shell_colvar_id)
1712 CALL acid_hyd_shell_colvar(colvar, cell, particles=particles)
1713 CASE (rmsd_colvar_id)
1714 CALL rmsd_colvar(colvar, particles=particles)
1715 CASE (reaction_path_colvar_id)
1716 CALL reaction_path_colvar(colvar, cell, particles=particles)
1717 CASE (distance_from_path_colvar_id)
1718 CALL distance_from_path_colvar(colvar, cell, particles=particles)
1719 CASE (combine_colvar_id)
1720 CALL combine_colvar(colvar, cell, particles=particles)
1721 CASE (xyz_diag_colvar_id)
1722 CALL xyz_diag_colvar(colvar, cell, particles=particles)
1723 CASE (xyz_outerdiag_colvar_id)
1724 CALL xyz_outerdiag_colvar(colvar, cell, particles=particles)
1725 CASE (ring_puckering_colvar_id)
1726 CALL ring_puckering_colvar(colvar, cell, particles=particles)
1727 CASE (mindist_colvar_id)
1728 CALL mindist_colvar(colvar, cell, particles=particles)
1729 CASE (u_colvar_id)
1730 cpabort("need force_env!")
1731 CASE (wc_colvar_id)
1732 !!! FIXME this is rubbish at the moment as we have no force to be computed on this
1733 CALL wc_colvar(colvar, cell, particles=particles)
1734 CASE (hbp_colvar_id)
1735 !!! FIXME this is rubbish at the moment as we have no force to be computed on this
1736 CALL hbp_colvar(colvar, cell, particles=particles)
1737 CASE (voronoiipz_colvar_id)
1738 CALL colvar_eval_voronoiipz(colvar, cell, particles=particles)
1739 CASE DEFAULT
1740 cpabort("Unknown colvar type for colvar_eval_mol_f")
1741 END SELECT
1742 ! Check for fixed atom constraints
1743 IF (PRESENT(fixd_list)) CALL check_fixed_atom_cns_colv(fixd_list, colvar)
1744
1745 END SUBROUTINE colvar_eval_mol_f
1746
1747! **************************************************************************************************
1748!> \brief evaluates the derivatives (dsdr) given and due to the given colvar
1749!> \param icolvar the collective variable to evaluate
1750!> \param force_env ...
1751!> \author Alessandro Laio and fawzi
1752!> \note
1753!> The torsion that generally is defined without the continuity problem
1754!> here (for free energy calculations) is defined only for (-pi,pi]
1755! **************************************************************************************************
1756 SUBROUTINE colvar_eval_glob_f(icolvar, force_env)
1757 INTEGER :: icolvar
1758 TYPE(force_env_type), POINTER :: force_env
1759
1760 LOGICAL :: colvar_ok
1761 TYPE(cell_type), POINTER :: cell
1762 TYPE(colvar_type), POINTER :: colvar
1763 TYPE(cp_subsys_type), POINTER :: subsys
1764 TYPE(qs_environment_type), POINTER :: qs_env
1765
1766 NULLIFY (subsys, cell, colvar, qs_env)
1767 CALL force_env_get(force_env, subsys=subsys, cell=cell, qs_env=qs_env)
1768 colvar_ok = ASSOCIATED(subsys%colvar_p)
1769 cpassert(colvar_ok)
1770
1771 colvar => subsys%colvar_p(icolvar)%colvar
1772 ! Initialize the content of the derivative
1773 colvar%dsdr = 0.0_dp
1774 SELECT CASE (colvar%type_id)
1775 CASE (dist_colvar_id)
1776 CALL dist_colvar(colvar, cell, subsys=subsys)
1777 CASE (coord_colvar_id)
1778 CALL coord_colvar(colvar, cell, subsys=subsys)
1779 CASE (population_colvar_id)
1780 CALL population_colvar(colvar, cell, subsys=subsys)
1781 CASE (gyration_colvar_id)
1782 CALL gyration_radius_colvar(colvar, cell, subsys=subsys)
1783 CASE (torsion_colvar_id)
1784 CALL torsion_colvar(colvar, cell, subsys=subsys, no_riemann_sheet_op=.true.)
1785 CASE (angle_colvar_id)
1786 CALL angle_colvar(colvar, cell, subsys=subsys)
1787 CASE (dfunct_colvar_id)
1788 CALL dfunct_colvar(colvar, cell, subsys=subsys)
1789 CASE (plane_distance_colvar_id)
1790 CALL plane_distance_colvar(colvar, cell, subsys=subsys)
1791 CASE (plane_plane_angle_colvar_id)
1792 CALL plane_plane_angle_colvar(colvar, cell, subsys=subsys)
1793 CASE (rotation_colvar_id)
1794 CALL rotation_colvar(colvar, cell, subsys=subsys)
1795 CASE (qparm_colvar_id)
1796 CALL qparm_colvar(colvar, cell, subsys=subsys)
1797 CASE (hydronium_shell_colvar_id)
1798 CALL hydronium_shell_colvar(colvar, cell, subsys=subsys)
1799 CASE (hydronium_dist_colvar_id)
1800 CALL hydronium_dist_colvar(colvar, cell, subsys=subsys)
1801 CASE (acid_hyd_dist_colvar_id)
1802 CALL acid_hyd_dist_colvar(colvar, cell, subsys=subsys)
1803 CASE (acid_hyd_shell_colvar_id)
1804 CALL acid_hyd_shell_colvar(colvar, cell, subsys=subsys)
1805 CASE (rmsd_colvar_id)
1806 CALL rmsd_colvar(colvar, subsys=subsys)
1807 CASE (reaction_path_colvar_id)
1808 CALL reaction_path_colvar(colvar, cell, subsys=subsys)
1809 CASE (distance_from_path_colvar_id)
1810 CALL distance_from_path_colvar(colvar, cell, subsys=subsys)
1811 CASE (combine_colvar_id)
1812 CALL combine_colvar(colvar, cell, subsys=subsys)
1813 CASE (xyz_diag_colvar_id)
1814 CALL xyz_diag_colvar(colvar, cell, subsys=subsys)
1815 CASE (xyz_outerdiag_colvar_id)
1816 CALL xyz_outerdiag_colvar(colvar, cell, subsys=subsys)
1817 CASE (u_colvar_id)
1818 CALL u_colvar(colvar, force_env=force_env)
1819 CASE (wc_colvar_id)
1820 CALL wc_colvar(colvar, cell, subsys=subsys, qs_env=qs_env)
1821 CASE (hbp_colvar_id)
1822 CALL hbp_colvar(colvar, cell, subsys=subsys, qs_env=qs_env)
1823 CASE (ring_puckering_colvar_id)
1824 CALL ring_puckering_colvar(colvar, cell, subsys=subsys)
1825 CASE (mindist_colvar_id)
1826 CALL mindist_colvar(colvar, cell, subsys=subsys)
1827 CASE (voronoiipz_colvar_id)
1828 CALL colvar_eval_voronoiipz(colvar, cell, subsys=subsys)
1829 CASE DEFAULT
1830 cpabort("Unknown colvar type for colvar_eval_glob_f")
1831 END SELECT
1832 ! Check for fixed atom constraints
1833 CALL check_fixed_atom_cns_colv(subsys%gci%fixd_list, colvar)
1834 END SUBROUTINE colvar_eval_glob_f
1835
1836! **************************************************************************************************
1837!> \brief evaluates the derivatives (dsdr) given and due to the given colvar
1838!> for the specification of a recursive colvar type
1839!> \param colvar the collective variable to evaluate
1840!> \param cell ...
1841!> \param particles ...
1842!> \author sfchiff
1843! **************************************************************************************************
1844 SUBROUTINE colvar_recursive_eval(colvar, cell, particles)
1845 TYPE(colvar_type), POINTER :: colvar
1846 TYPE(cell_type), POINTER :: cell
1847 TYPE(particle_type), DIMENSION(:), POINTER :: particles
1848
1849! Initialize the content of the derivative
1850
1851 colvar%dsdr = 0.0_dp
1852 SELECT CASE (colvar%type_id)
1853 CASE (dist_colvar_id)
1854 CALL dist_colvar(colvar, cell, particles=particles)
1855 CASE (coord_colvar_id)
1856 CALL coord_colvar(colvar, cell, particles=particles)
1857 CASE (torsion_colvar_id)
1858 CALL torsion_colvar(colvar, cell, particles=particles)
1859 CASE (angle_colvar_id)
1860 CALL angle_colvar(colvar, cell, particles=particles)
1861 CASE (dfunct_colvar_id)
1862 CALL dfunct_colvar(colvar, cell, particles=particles)
1863 CASE (plane_distance_colvar_id)
1864 CALL plane_distance_colvar(colvar, cell, particles=particles)
1865 CASE (plane_plane_angle_colvar_id)
1866 CALL plane_plane_angle_colvar(colvar, cell, particles=particles)
1867 CASE (rotation_colvar_id)
1868 CALL rotation_colvar(colvar, cell, particles=particles)
1869 CASE (qparm_colvar_id)
1870 CALL qparm_colvar(colvar, cell, particles=particles)
1871 CASE (hydronium_shell_colvar_id)
1872 CALL hydronium_shell_colvar(colvar, cell, particles=particles)
1873 CASE (hydronium_dist_colvar_id)
1874 CALL hydronium_dist_colvar(colvar, cell, particles=particles)
1875 CASE (acid_hyd_dist_colvar_id)
1876 CALL acid_hyd_dist_colvar(colvar, cell, particles=particles)
1877 CASE (acid_hyd_shell_colvar_id)
1878 CALL acid_hyd_shell_colvar(colvar, cell, particles=particles)
1879 CASE (rmsd_colvar_id)
1880 CALL rmsd_colvar(colvar, particles=particles)
1881 CASE (reaction_path_colvar_id)
1882 CALL reaction_path_colvar(colvar, cell, particles=particles)
1883 CASE (distance_from_path_colvar_id)
1884 CALL distance_from_path_colvar(colvar, cell, particles=particles)
1885 CASE (combine_colvar_id)
1886 CALL combine_colvar(colvar, cell, particles=particles)
1887 CASE (xyz_diag_colvar_id)
1888 CALL xyz_diag_colvar(colvar, cell, particles=particles)
1889 CASE (xyz_outerdiag_colvar_id)
1890 CALL xyz_outerdiag_colvar(colvar, cell, particles=particles)
1891 CASE (ring_puckering_colvar_id)
1892 CALL ring_puckering_colvar(colvar, cell, particles=particles)
1893 CASE (mindist_colvar_id)
1894 CALL mindist_colvar(colvar, cell, particles=particles)
1895 CASE (u_colvar_id)
1896 cpabort("need force_env!")
1897 CASE (wc_colvar_id)
1898 CALL wc_colvar(colvar, cell, particles=particles)
1899 CASE (hbp_colvar_id)
1900 CALL hbp_colvar(colvar, cell, particles=particles)
1901 CASE (voronoiipz_colvar_id)
1902 CALL colvar_eval_voronoiipz(colvar, cell, particles=particles)
1903 CASE DEFAULT
1904 cpabort("Unknown colvar type for colvar_recursive_eval")
1905 END SELECT
1906 END SUBROUTINE colvar_recursive_eval
1907
1908! **************************************************************************************************
1909!> \brief Get coordinates of atoms or of geometrical points
1910!> \param colvar ...
1911!> \param i ...
1912!> \param ri ...
1913!> \param my_particles ...
1914!> \author Teodoro Laino 03.2007 [created]
1915! **************************************************************************************************
1916 SUBROUTINE get_coordinates(colvar, i, ri, my_particles)
1917 TYPE(colvar_type), POINTER :: colvar
1918 INTEGER, INTENT(IN) :: i
1919 REAL(kind=dp), DIMENSION(3), INTENT(OUT) :: ri
1920 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
1921
1922 IF (colvar%use_points) THEN
1923 CALL eval_point_pos(colvar%points(i), my_particles, ri)
1924 ELSE
1925 ri(:) = my_particles(i)%r(:)
1926 END IF
1927
1928 END SUBROUTINE get_coordinates
1929
1930! **************************************************************************************************
1931!> \brief Get masses of atoms or of geometrical points
1932!> \param colvar ...
1933!> \param i ...
1934!> \param mi ...
1935!> \param my_particles ...
1936!> \author Teodoro Laino 03.2007 [created]
1937! **************************************************************************************************
1938 SUBROUTINE get_mass(colvar, i, mi, my_particles)
1939 TYPE(colvar_type), POINTER :: colvar
1940 INTEGER, INTENT(IN) :: i
1941 REAL(kind=dp), INTENT(OUT) :: mi
1942 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
1943
1944 IF (colvar%use_points) THEN
1945 CALL eval_point_mass(colvar%points(i), my_particles, mi)
1946 ELSE
1947 mi = my_particles(i)%atomic_kind%mass
1948 END IF
1949
1950 END SUBROUTINE get_mass
1951
1952! **************************************************************************************************
1953!> \brief Transfer derivatives to ds/dr
1954!> \param colvar ...
1955!> \param i ...
1956!> \param fi ...
1957!> \author Teodoro Laino 03.2007 [created]
1958! **************************************************************************************************
1959 SUBROUTINE put_derivative(colvar, i, fi)
1960 TYPE(colvar_type), POINTER :: colvar
1961 INTEGER, INTENT(IN) :: i
1962 REAL(kind=dp), DIMENSION(3), INTENT(IN) :: fi
1963
1964 IF (colvar%use_points) THEN
1965 CALL eval_point_der(colvar%points, i, colvar%dsdr, fi)
1966 ELSE
1967 colvar%dsdr(:, i) = colvar%dsdr(:, i) + fi
1968 END IF
1969
1970 END SUBROUTINE put_derivative
1971
1972! **************************************************************************************************
1973!> \brief evaluates the force due to the position colvar
1974!> \param colvar ...
1975!> \param cell ...
1976!> \param subsys ...
1977!> \param particles ...
1978!> \author Teodoro Laino 02.2010 [created]
1979! **************************************************************************************************
1980 SUBROUTINE xyz_diag_colvar(colvar, cell, subsys, particles)
1981 TYPE(colvar_type), POINTER :: colvar
1982 TYPE(cell_type), POINTER :: cell
1983 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
1984 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
1985 POINTER :: particles
1986
1987 INTEGER :: i
1988 REAL(dp) :: fi(3), r, r0(3), ss(3), xi(3), xpi(3)
1989 TYPE(particle_list_type), POINTER :: particles_i
1990 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
1991
1992 NULLIFY (particles_i)
1993
1994 cpassert(colvar%type_id == xyz_diag_colvar_id)
1995 IF (PRESENT(particles)) THEN
1996 my_particles => particles
1997 ELSE
1998 cpassert(PRESENT(subsys))
1999 CALL cp_subsys_get(subsys, particles=particles_i)
2000 my_particles => particles_i%els
2001 END IF
2002 i = colvar%xyz_diag_param%i_atom
2003 ! Atom coordinates
2004 CALL get_coordinates(colvar, i, xpi, my_particles)
2005 ! Use the current coordinates as initial coordinates, if no initialization
2006 ! was performed yet
2007 IF (.NOT. colvar%xyz_diag_param%use_absolute_position) THEN
2008 IF (all(colvar%xyz_diag_param%r0 == huge(0.0_dp))) THEN
2009 colvar%xyz_diag_param%r0 = xpi
2010 END IF
2011 r0 = colvar%xyz_diag_param%r0
2012 ELSE
2013 r0 = 0.0_dp
2014 END IF
2015
2016 IF (colvar%xyz_diag_param%use_pbc) THEN
2017 ss = matmul(cell%h_inv, xpi - r0)
2018 ss = ss - nint(ss)
2019 xi = matmul(cell%hmat, ss)
2020 ELSE
2021 xi = xpi - r0
2022 END IF
2023
2024 IF (.NOT. colvar%xyz_diag_param%use_absolute_position) THEN
2025 SELECT CASE (colvar%xyz_diag_param%component)
2026 CASE (do_clv_x)
2027 xi(2) = 0.0_dp
2028 xi(3) = 0.0_dp
2029 CASE (do_clv_y)
2030 xi(1) = 0.0_dp
2031 xi(3) = 0.0_dp
2032 CASE (do_clv_z)
2033 xi(1) = 0.0_dp
2034 xi(2) = 0.0_dp
2035 CASE (do_clv_xy)
2036 xi(3) = 0.0_dp
2037 CASE (do_clv_xz)
2038 xi(2) = 0.0_dp
2039 CASE (do_clv_yz)
2040 xi(1) = 0.0_dp
2041 CASE DEFAULT
2042 ! do_clv_xyz
2043 END SELECT
2044
2045 r = xi(1)**2 + xi(2)**2 + xi(3)**2
2046 fi(:) = 2.0_dp*xi
2047 ELSE
2048 SELECT CASE (colvar%xyz_diag_param%component)
2049 CASE (do_clv_x)
2050 r = xi(1)
2051 xi(1) = 1.0_dp
2052 xi(2) = 0.0_dp
2053 xi(3) = 0.0_dp
2054 CASE (do_clv_y)
2055 r = xi(2)
2056 xi(1) = 0.0_dp
2057 xi(2) = 1.0_dp
2058 xi(3) = 0.0_dp
2059 CASE (do_clv_z)
2060 r = xi(3)
2061 xi(1) = 0.0_dp
2062 xi(2) = 0.0_dp
2063 xi(3) = 1.0_dp
2064 CASE DEFAULT
2065 cpabort("xyz_diag_colvar not implemented for anything which is not a single component")
2066 END SELECT
2067 fi(:) = xi
2068 END IF
2069
2070 colvar%ss = r
2071 CALL put_derivative(colvar, 1, fi)
2072
2073 END SUBROUTINE xyz_diag_colvar
2074
2075! **************************************************************************************************
2076!> \brief evaluates the force due to the position colvar
2077!> \param colvar ...
2078!> \param cell ...
2079!> \param subsys ...
2080!> \param particles ...
2081!> \author Teodoro Laino 02.2010 [created]
2082! **************************************************************************************************
2083 SUBROUTINE xyz_outerdiag_colvar(colvar, cell, subsys, particles)
2084 TYPE(colvar_type), POINTER :: colvar
2085 TYPE(cell_type), POINTER :: cell
2086 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2087 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2088 POINTER :: particles
2089
2090 INTEGER :: i, k, l
2091 REAL(dp) :: fi(3, 2), r, r0(3), ss(3), xi(3, 2), &
2092 xpi(3)
2093 TYPE(particle_list_type), POINTER :: particles_i
2094 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2095
2096 NULLIFY (particles_i)
2097
2098 cpassert(colvar%type_id == xyz_outerdiag_colvar_id)
2099 IF (PRESENT(particles)) THEN
2100 my_particles => particles
2101 ELSE
2102 cpassert(PRESENT(subsys))
2103 CALL cp_subsys_get(subsys, particles=particles_i)
2104 my_particles => particles_i%els
2105 END IF
2106 DO k = 1, 2
2107 i = colvar%xyz_outerdiag_param%i_atoms(k)
2108 ! Atom coordinates
2109 CALL get_coordinates(colvar, i, xpi, my_particles)
2110 r0 = colvar%xyz_outerdiag_param%r0(:, k)
2111 IF (all(colvar%xyz_outerdiag_param%r0(:, k) == huge(0.0_dp))) r0 = xpi
2112
2113 IF (colvar%xyz_outerdiag_param%use_pbc) THEN
2114 ss = matmul(cell%h_inv, xpi - r0)
2115 ss = ss - nint(ss)
2116 xi(:, k) = matmul(cell%hmat, ss)
2117 ELSE
2118 xi(:, k) = xpi - r0
2119 END IF
2120
2121 SELECT CASE (colvar%xyz_outerdiag_param%components(k))
2122 CASE (do_clv_x)
2123 xi(2, k) = 0.0_dp
2124 xi(3, k) = 0.0_dp
2125 CASE (do_clv_y)
2126 xi(1, k) = 0.0_dp
2127 xi(3, k) = 0.0_dp
2128 CASE (do_clv_z)
2129 xi(1, k) = 0.0_dp
2130 xi(2, k) = 0.0_dp
2131 CASE (do_clv_xy)
2132 xi(3, k) = 0.0_dp
2133 CASE (do_clv_xz)
2134 xi(2, k) = 0.0_dp
2135 CASE (do_clv_yz)
2136 xi(1, k) = 0.0_dp
2137 CASE DEFAULT
2138 ! do_clv_xyz
2139 END SELECT
2140 END DO
2141
2142 r = 0.0_dp
2143 fi = 0.0_dp
2144 DO i = 1, 3
2145 DO l = 1, 3
2146 IF (xi(l, 1) /= 0.0_dp) fi(l, 1) = fi(l, 1) + xi(i, 2)
2147 r = r + xi(l, 1)*xi(i, 2)
2148 END DO
2149 IF (xi(i, 2) /= 0.0_dp) fi(i, 2) = sum(xi(:, 1))
2150 END DO
2151
2152 colvar%ss = r
2153 CALL put_derivative(colvar, 1, fi(:, 1))
2154 CALL put_derivative(colvar, 2, fi(:, 2))
2155
2156 END SUBROUTINE xyz_outerdiag_colvar
2157
2158! **************************************************************************************************
2159!> \brief evaluates the force due (and on) the energy as collective variable
2160!> \param colvar ...
2161!> \param force_env ...
2162!> \par History Modified to allow functions of energy in a mixed_env environment
2163!> Teodoro Laino [tlaino] - 02.2011
2164!> \author Sebastiano Caravati
2165! **************************************************************************************************
2166 SUBROUTINE u_colvar(colvar, force_env)
2167 TYPE(colvar_type), POINTER :: colvar
2168 TYPE(force_env_type), OPTIONAL, POINTER :: force_env
2169
2170 CHARACTER(LEN=default_path_length) :: coupling_function
2171 CHARACTER(LEN=default_string_length) :: def_error, this_error
2172 CHARACTER(LEN=default_string_length), &
2173 DIMENSION(:), POINTER :: parameters
2174 INTEGER :: iatom, iforce_eval, iparticle, &
2175 jparticle, natom, natom_iforce, &
2176 nforce_eval
2177 INTEGER, DIMENSION(:), POINTER :: glob_natoms, map_index
2178 REAL(dp) :: dedf, dx, err, fi(3), lerr, &
2179 potential_energy
2180 REAL(kind=dp), DIMENSION(:), POINTER :: values
2181 TYPE(cp_subsys_p_type), DIMENSION(:), POINTER :: subsystems
2182 TYPE(cp_subsys_type), POINTER :: subsys_main
2183 TYPE(mixed_force_type), DIMENSION(:), POINTER :: global_forces
2184 TYPE(particle_list_p_type), DIMENSION(:), POINTER :: particles
2185 TYPE(particle_list_type), POINTER :: particles_main
2186 TYPE(section_vals_type), POINTER :: force_env_section, mapping_section, &
2187 wrk_section
2188
2189 IF (PRESENT(force_env)) THEN
2190 NULLIFY (particles_main, subsys_main)
2191 CALL force_env_get(force_env=force_env, subsys=subsys_main)
2192 CALL cp_subsys_get(subsys=subsys_main, particles=particles_main)
2193 natom = SIZE(particles_main%els)
2194 colvar%n_atom_s = natom
2195 colvar%u_param%natom = natom
2196 CALL reallocate(colvar%i_atom, 1, natom)
2197 CALL reallocate(colvar%dsdr, 1, 3, 1, natom)
2198 DO iatom = 1, natom
2199 colvar%i_atom(iatom) = iatom
2200 END DO
2201
2202 IF (.NOT. ASSOCIATED(colvar%u_param%mixed_energy_section)) THEN
2203 CALL force_env_get(force_env, potential_energy=potential_energy)
2204 colvar%ss = potential_energy
2205
2206 DO iatom = 1, natom
2207 ! store derivative
2208 fi(:) = -particles_main%els(iatom)%f
2209 CALL put_derivative(colvar, iatom, fi)
2210 END DO
2211 ELSE
2212 IF (force_env%in_use /= use_mixed_force) THEN
2213 CALL cp_abort(__location__, &
2214 'ASSERTION (cond) failed at line '//cp_to_string(__line__)// &
2215 ' A combination of mixed force_eval energies has been requested as '// &
2216 ' collective variable, but the MIXED env is not in use! Aborting.')
2217 END IF
2218 CALL force_env_get(force_env, force_env_section=force_env_section)
2219 mapping_section => section_vals_get_subs_vals(force_env_section, "MIXED%MAPPING")
2220 NULLIFY (values, parameters, subsystems, particles, global_forces, map_index, glob_natoms)
2221 nforce_eval = SIZE(force_env%sub_force_env)
2222 ALLOCATE (glob_natoms(nforce_eval))
2223 ALLOCATE (subsystems(nforce_eval))
2224 ALLOCATE (particles(nforce_eval))
2225 ! Local Info to sync
2226 ALLOCATE (global_forces(nforce_eval))
2227
2228 glob_natoms = 0
2229 DO iforce_eval = 1, nforce_eval
2230 NULLIFY (subsystems(iforce_eval)%subsys, particles(iforce_eval)%list)
2231 IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) cycle
2232 ! Get all available subsys
2233 CALL force_env_get(force_env=force_env%sub_force_env(iforce_eval)%force_env, &
2234 subsys=subsystems(iforce_eval)%subsys)
2235 ! Get available particles
2236 CALL cp_subsys_get(subsys=subsystems(iforce_eval)%subsys, &
2237 particles=particles(iforce_eval)%list)
2238
2239 ! Get Mapping index array
2240 natom_iforce = SIZE(particles(iforce_eval)%list%els)
2241
2242 ! Only the rank 0 process collect info for each computation
2243 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
2244 glob_natoms(iforce_eval) = natom_iforce
2245 END IF
2246 END DO
2247
2248 ! Handling Parallel execution
2249 CALL force_env%para_env%sync()
2250 CALL force_env%para_env%sum(glob_natoms)
2251
2252 ! Transfer forces
2253 DO iforce_eval = 1, nforce_eval
2254 ALLOCATE (global_forces(iforce_eval)%forces(3, glob_natoms(iforce_eval)))
2255 global_forces(iforce_eval)%forces = 0.0_dp
2256 IF (ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) THEN
2257 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
2258 ! Forces
2259 DO iparticle = 1, glob_natoms(iforce_eval)
2260 global_forces(iforce_eval)%forces(:, iparticle) = &
2261 particles(iforce_eval)%list%els(iparticle)%f
2262 END DO
2263 END IF
2264 END IF
2265 CALL force_env%para_env%sum(global_forces(iforce_eval)%forces)
2266 END DO
2267
2268 wrk_section => colvar%u_param%mixed_energy_section
2269 ! Support any number of force_eval sections
2270 CALL get_generic_info(wrk_section, "ENERGY_FUNCTION", coupling_function, parameters, &
2271 values, force_env%mixed_env%energies)
2272 CALL initf(1)
2273 CALL parsef(1, trim(coupling_function), parameters)
2274 ! Store the value of the COLVAR
2275 colvar%ss = evalf(1, values)
2276 cpassert(evalerrtype <= 0)
2277
2278 DO iforce_eval = 1, nforce_eval
2279 CALL section_vals_val_get(wrk_section, "DX", r_val=dx)
2280 CALL section_vals_val_get(wrk_section, "ERROR_LIMIT", r_val=lerr)
2281 dedf = evalfd(1, iforce_eval, values, dx, err)
2282 IF (abs(err) > lerr) THEN
2283 WRITE (this_error, "(A,G12.6,A)") "(", err, ")"
2284 WRITE (def_error, "(A,G12.6,A)") "(", lerr, ")"
2285 CALL compress(this_error, .true.)
2286 CALL compress(def_error, .true.)
2287 CALL cp_warn(__location__, &
2288 'ASSERTION (cond) failed at line '//cp_to_string(__line__)// &
2289 ' Error '//trim(this_error)//' in computing numerical derivatives larger then'// &
2290 trim(def_error)//' .')
2291 END IF
2292 ! General Mapping of forces...
2293 ! First: Get Mapping index array
2294 CALL get_subsys_map_index(mapping_section, glob_natoms(iforce_eval), iforce_eval, &
2295 nforce_eval, map_index)
2296
2297 ! Second: store derivatives
2298 DO iparticle = 1, glob_natoms(iforce_eval)
2299 jparticle = map_index(iparticle)
2300 fi = -dedf*global_forces(iforce_eval)%forces(:, iparticle)
2301 CALL put_derivative(colvar, jparticle, fi)
2302 END DO
2303 ! Deallocate map_index array
2304 IF (ASSOCIATED(map_index)) THEN
2305 DEALLOCATE (map_index)
2306 END IF
2307 END DO
2308 CALL finalizef()
2309 DO iforce_eval = 1, nforce_eval
2310 DEALLOCATE (global_forces(iforce_eval)%forces)
2311 END DO
2312 DEALLOCATE (glob_natoms)
2313 DEALLOCATE (values)
2314 DEALLOCATE (parameters)
2315 DEALLOCATE (global_forces)
2316 DEALLOCATE (subsystems)
2317 DEALLOCATE (particles)
2318 END IF
2319 ELSE
2320 cpabort("need force_env!")
2321 END IF
2322 END SUBROUTINE u_colvar
2323
2324! **************************************************************************************************
2325!> \brief evaluates the force due (and on) the distance from the plane collective variable
2326!> \param colvar ...
2327!> \param cell ...
2328!> \param subsys ...
2329!> \param particles ...
2330!> \author Teodoro Laino 02.2006 [created]
2331! **************************************************************************************************
2332 SUBROUTINE plane_distance_colvar(colvar, cell, subsys, particles)
2333
2334 TYPE(colvar_type), POINTER :: colvar
2335 TYPE(cell_type), POINTER :: cell
2336 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2337 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2338 POINTER :: particles
2339
2340 INTEGER :: i, j, k, l
2341 REAL(dp) :: a, b, dsdxpn(3), dxpndxi(3, 3), dxpndxj(3, 3), dxpndxk(3, 3), fi(3), fj(3), &
2342 fk(3), fl(3), r12, ri(3), rj(3), rk(3), rl(3), ss(3), xpij(3), xpkj(3), xpl(3), xpn(3)
2343 TYPE(particle_list_type), POINTER :: particles_i
2344 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2345
2346 NULLIFY (particles_i)
2347
2348 cpassert(colvar%type_id == plane_distance_colvar_id)
2349 IF (PRESENT(particles)) THEN
2350 my_particles => particles
2351 ELSE
2352 cpassert(PRESENT(subsys))
2353 CALL cp_subsys_get(subsys, particles=particles_i)
2354 my_particles => particles_i%els
2355 END IF
2356 i = colvar%plane_distance_param%plane(1)
2357 j = colvar%plane_distance_param%plane(2)
2358 k = colvar%plane_distance_param%plane(3)
2359 l = colvar%plane_distance_param%point
2360 ! Get coordinates of atoms or points
2361 CALL get_coordinates(colvar, i, ri, my_particles)
2362 CALL get_coordinates(colvar, j, rj, my_particles)
2363 CALL get_coordinates(colvar, k, rk, my_particles)
2364 CALL get_coordinates(colvar, l, rl, my_particles)
2365 xpij = ri - rj
2366 xpkj = rk - rj
2367 xpl = rl - (ri + rj + rk)/3.0_dp
2368 IF (colvar%plane_distance_param%use_pbc) THEN
2369 ! xpij
2370 ss = matmul(cell%h_inv, ri - rj)
2371 ss = ss - nint(ss)
2372 xpij = matmul(cell%hmat, ss)
2373 ! xpkj
2374 ss = matmul(cell%h_inv, rk - rj)
2375 ss = ss - nint(ss)
2376 xpkj = matmul(cell%hmat, ss)
2377 ! xpl
2378 ss = matmul(cell%h_inv, rl - (ri + rj + rk)/3.0_dp)
2379 ss = ss - nint(ss)
2380 xpl = matmul(cell%hmat, ss)
2381 END IF
2382 ! xpn
2383 xpn(1) = xpij(2)*xpkj(3) - xpij(3)*xpkj(2)
2384 xpn(2) = xpij(3)*xpkj(1) - xpij(1)*xpkj(3)
2385 xpn(3) = xpij(1)*xpkj(2) - xpij(2)*xpkj(1)
2386 a = dot_product(xpn, xpn)
2387 b = dot_product(xpl, xpn)
2388 r12 = sqrt(a)
2389 colvar%ss = b/r12
2390 dsdxpn(1) = xpl(1)/r12 - b*xpn(1)/(r12*a)
2391 dsdxpn(2) = xpl(2)/r12 - b*xpn(2)/(r12*a)
2392 dsdxpn(3) = xpl(3)/r12 - b*xpn(3)/(r12*a)
2393 !
2394 dxpndxi(1, 1) = 0.0_dp
2395 dxpndxi(1, 2) = 1.0_dp*xpkj(3)
2396 dxpndxi(1, 3) = -1.0_dp*xpkj(2)
2397 dxpndxi(2, 1) = -1.0_dp*xpkj(3)
2398 dxpndxi(2, 2) = 0.0_dp
2399 dxpndxi(2, 3) = 1.0_dp*xpkj(1)
2400 dxpndxi(3, 1) = 1.0_dp*xpkj(2)
2401 dxpndxi(3, 2) = -1.0_dp*xpkj(1)
2402 dxpndxi(3, 3) = 0.0_dp
2403 !
2404 dxpndxj(1, 1) = 0.0_dp
2405 dxpndxj(1, 2) = -1.0_dp*xpkj(3) + xpij(3)
2406 dxpndxj(1, 3) = -1.0_dp*xpij(2) + xpkj(2)
2407 dxpndxj(2, 1) = -1.0_dp*xpij(3) + xpkj(3)
2408 dxpndxj(2, 2) = 0.0_dp
2409 dxpndxj(2, 3) = -1.0_dp*xpkj(1) + xpij(1)
2410 dxpndxj(3, 1) = -1.0_dp*xpkj(2) + xpij(2)
2411 dxpndxj(3, 2) = -1.0_dp*xpij(1) + xpkj(1)
2412 dxpndxj(3, 3) = 0.0_dp
2413 !
2414 dxpndxk(1, 1) = 0.0_dp
2415 dxpndxk(1, 2) = -1.0_dp*xpij(3)
2416 dxpndxk(1, 3) = 1.0_dp*xpij(2)
2417 dxpndxk(2, 1) = 1.0_dp*xpij(3)
2418 dxpndxk(2, 2) = 0.0_dp
2419 dxpndxk(2, 3) = -1.0_dp*xpij(1)
2420 dxpndxk(3, 1) = -1.0_dp*xpij(2)
2421 dxpndxk(3, 2) = 1.0_dp*xpij(1)
2422 dxpndxk(3, 3) = 0.0_dp
2423 !
2424 fi(:) = matmul(dsdxpn, dxpndxi) - xpn/(3.0_dp*r12)
2425 fj(:) = matmul(dsdxpn, dxpndxj) - xpn/(3.0_dp*r12)
2426 fk(:) = matmul(dsdxpn, dxpndxk) - xpn/(3.0_dp*r12)
2427 fl(:) = xpn/r12
2428 ! Transfer derivatives on atoms
2429 CALL put_derivative(colvar, 1, fi)
2430 CALL put_derivative(colvar, 2, fj)
2431 CALL put_derivative(colvar, 3, fk)
2432 CALL put_derivative(colvar, 4, fl)
2433
2434 END SUBROUTINE plane_distance_colvar
2435
2436! **************************************************************************************************
2437!> \brief evaluates the force due (and on) the angle between two planes.
2438!> plane-plane angle collective variable
2439!> \param colvar ...
2440!> \param cell ...
2441!> \param subsys ...
2442!> \param particles ...
2443!> \author Teodoro Laino 02.2009 [created]
2444! **************************************************************************************************
2445 SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles)
2446
2447 TYPE(colvar_type), POINTER :: colvar
2448 TYPE(cell_type), POINTER :: cell
2449 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2450 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2451 POINTER :: particles
2452
2453 INTEGER :: i1, i2, j1, j2, k1, k2, np
2454 LOGICAL :: check
2455 REAL(dp) :: a1, a2, d, dnorm_dxpn(3), dprod12_dxpn(3), dsdxpn(3), dt_dxpn(3), dxpndxi(3, 3), &
2456 dxpndxj(3, 3), dxpndxk(3, 3), fi(3), fj(3), fk(3), fmod, norm1, norm2, prod_12, ri1(3), &
2457 ri2(3), rj1(3), rj2(3), rk1(3), rk2(3), ss(3), t, xpij1(3), xpij2(3), xpkj1(3), xpkj2(3), &
2458 xpn1(3), xpn2(3)
2459 TYPE(particle_list_type), POINTER :: particles_i
2460 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2461
2462 NULLIFY (particles_i)
2463
2464 check = colvar%type_id == plane_plane_angle_colvar_id
2465 cpassert(check)
2466 IF (PRESENT(particles)) THEN
2467 my_particles => particles
2468 ELSE
2469 cpassert(PRESENT(subsys))
2470 CALL cp_subsys_get(subsys, particles=particles_i)
2471 my_particles => particles_i%els
2472 END IF
2473
2474 ! Plane 1
2475 IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) THEN
2476 i1 = colvar%plane_plane_angle_param%plane1%points(1)
2477 j1 = colvar%plane_plane_angle_param%plane1%points(2)
2478 k1 = colvar%plane_plane_angle_param%plane1%points(3)
2479
2480 ! Get coordinates of atoms or points
2481 CALL get_coordinates(colvar, i1, ri1, my_particles)
2482 CALL get_coordinates(colvar, j1, rj1, my_particles)
2483 CALL get_coordinates(colvar, k1, rk1, my_particles)
2484
2485 ! xpij
2486 ss = matmul(cell%h_inv, ri1 - rj1)
2487 ss = ss - nint(ss)
2488 xpij1 = matmul(cell%hmat, ss)
2489
2490 ! xpkj
2491 ss = matmul(cell%h_inv, rk1 - rj1)
2492 ss = ss - nint(ss)
2493 xpkj1 = matmul(cell%hmat, ss)
2494
2495 ! xpn
2496 xpn1(1) = xpij1(2)*xpkj1(3) - xpij1(3)*xpkj1(2)
2497 xpn1(2) = xpij1(3)*xpkj1(1) - xpij1(1)*xpkj1(3)
2498 xpn1(3) = xpij1(1)*xpkj1(2) - xpij1(2)*xpkj1(1)
2499 ELSE
2500 xpn1 = colvar%plane_plane_angle_param%plane1%normal_vec
2501 END IF
2502 a1 = dot_product(xpn1, xpn1)
2503 norm1 = sqrt(a1)
2504 cpassert(norm1 /= 0.0_dp)
2505
2506 ! Plane 2
2507 IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) THEN
2508 i2 = colvar%plane_plane_angle_param%plane2%points(1)
2509 j2 = colvar%plane_plane_angle_param%plane2%points(2)
2510 k2 = colvar%plane_plane_angle_param%plane2%points(3)
2511
2512 ! Get coordinates of atoms or points
2513 CALL get_coordinates(colvar, i2, ri2, my_particles)
2514 CALL get_coordinates(colvar, j2, rj2, my_particles)
2515 CALL get_coordinates(colvar, k2, rk2, my_particles)
2516
2517 ! xpij
2518 ss = matmul(cell%h_inv, ri2 - rj2)
2519 ss = ss - nint(ss)
2520 xpij2 = matmul(cell%hmat, ss)
2521
2522 ! xpkj
2523 ss = matmul(cell%h_inv, rk2 - rj2)
2524 ss = ss - nint(ss)
2525 xpkj2 = matmul(cell%hmat, ss)
2526
2527 ! xpn
2528 xpn2(1) = xpij2(2)*xpkj2(3) - xpij2(3)*xpkj2(2)
2529 xpn2(2) = xpij2(3)*xpkj2(1) - xpij2(1)*xpkj2(3)
2530 xpn2(3) = xpij2(1)*xpkj2(2) - xpij2(2)*xpkj2(1)
2531 ELSE
2532 xpn2 = colvar%plane_plane_angle_param%plane2%normal_vec
2533 END IF
2534 a2 = dot_product(xpn2, xpn2)
2535 norm2 = sqrt(a2)
2536 cpassert(norm2 /= 0.0_dp)
2537
2538 ! The value of the angle is defined only between 0 and Pi
2539 prod_12 = dot_product(xpn1, xpn2)
2540
2541 d = norm1*norm2
2542 t = prod_12/d
2543 t = min(1.0_dp, abs(t))*sign(1.0_dp, t)
2544 colvar%ss = acos(t)
2545
2546 IF ((abs(colvar%ss) < tolerance_acos) .OR. (abs(colvar%ss - pi) < tolerance_acos)) THEN
2547 fmod = 0.0_dp
2548 ELSE
2549 fmod = -1.0_dp/sin(colvar%ss)
2550 END IF
2551 ! Compute derivatives
2552 np = 0
2553 ! Plane 1
2554 IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) THEN
2555 dprod12_dxpn = xpn2
2556 dnorm_dxpn = 1.0_dp/norm1*xpn1
2557 dt_dxpn = (dprod12_dxpn*d - prod_12*dnorm_dxpn*norm2)/d**2
2558
2559 dsdxpn(1) = fmod*dt_dxpn(1)
2560 dsdxpn(2) = fmod*dt_dxpn(2)
2561 dsdxpn(3) = fmod*dt_dxpn(3)
2562 !
2563 dxpndxi(1, 1) = 0.0_dp
2564 dxpndxi(1, 2) = 1.0_dp*xpkj1(3)
2565 dxpndxi(1, 3) = -1.0_dp*xpkj1(2)
2566 dxpndxi(2, 1) = -1.0_dp*xpkj1(3)
2567 dxpndxi(2, 2) = 0.0_dp
2568 dxpndxi(2, 3) = 1.0_dp*xpkj1(1)
2569 dxpndxi(3, 1) = 1.0_dp*xpkj1(2)
2570 dxpndxi(3, 2) = -1.0_dp*xpkj1(1)
2571 dxpndxi(3, 3) = 0.0_dp
2572 !
2573 dxpndxj(1, 1) = 0.0_dp
2574 dxpndxj(1, 2) = -1.0_dp*xpkj1(3) + xpij1(3)
2575 dxpndxj(1, 3) = -1.0_dp*xpij1(2) + xpkj1(2)
2576 dxpndxj(2, 1) = -1.0_dp*xpij1(3) + xpkj1(3)
2577 dxpndxj(2, 2) = 0.0_dp
2578 dxpndxj(2, 3) = -1.0_dp*xpkj1(1) + xpij1(1)
2579 dxpndxj(3, 1) = -1.0_dp*xpkj1(2) + xpij1(2)
2580 dxpndxj(3, 2) = -1.0_dp*xpij1(1) + xpkj1(1)
2581 dxpndxj(3, 3) = 0.0_dp
2582 !
2583 dxpndxk(1, 1) = 0.0_dp
2584 dxpndxk(1, 2) = -1.0_dp*xpij1(3)
2585 dxpndxk(1, 3) = 1.0_dp*xpij1(2)
2586 dxpndxk(2, 1) = 1.0_dp*xpij1(3)
2587 dxpndxk(2, 2) = 0.0_dp
2588 dxpndxk(2, 3) = -1.0_dp*xpij1(1)
2589 dxpndxk(3, 1) = -1.0_dp*xpij1(2)
2590 dxpndxk(3, 2) = 1.0_dp*xpij1(1)
2591 dxpndxk(3, 3) = 0.0_dp
2592 !
2593 fi = matmul(dsdxpn, dxpndxi)
2594 fj = matmul(dsdxpn, dxpndxj)
2595 fk = matmul(dsdxpn, dxpndxk)
2596
2597 ! Transfer derivatives on atoms
2598 CALL put_derivative(colvar, np + 1, fi)
2599 CALL put_derivative(colvar, np + 2, fj)
2600 CALL put_derivative(colvar, np + 3, fk)
2601 np = 3
2602 END IF
2603
2604 ! Plane 2
2605 IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) THEN
2606 dprod12_dxpn = xpn1
2607 dnorm_dxpn = 1.0_dp/norm2*xpn2
2608 dt_dxpn = (dprod12_dxpn*d - prod_12*dnorm_dxpn*norm1)/d**2
2609
2610 dsdxpn(1) = fmod*dt_dxpn(1)
2611 dsdxpn(2) = fmod*dt_dxpn(2)
2612 dsdxpn(3) = fmod*dt_dxpn(3)
2613 !
2614 dxpndxi(1, 1) = 0.0_dp
2615 dxpndxi(1, 2) = 1.0_dp*xpkj1(3)
2616 dxpndxi(1, 3) = -1.0_dp*xpkj1(2)
2617 dxpndxi(2, 1) = -1.0_dp*xpkj1(3)
2618 dxpndxi(2, 2) = 0.0_dp
2619 dxpndxi(2, 3) = 1.0_dp*xpkj1(1)
2620 dxpndxi(3, 1) = 1.0_dp*xpkj1(2)
2621 dxpndxi(3, 2) = -1.0_dp*xpkj1(1)
2622 dxpndxi(3, 3) = 0.0_dp
2623 !
2624 dxpndxj(1, 1) = 0.0_dp
2625 dxpndxj(1, 2) = -1.0_dp*xpkj1(3) + xpij1(3)
2626 dxpndxj(1, 3) = -1.0_dp*xpij1(2) + xpkj1(2)
2627 dxpndxj(2, 1) = -1.0_dp*xpij1(3) + xpkj1(3)
2628 dxpndxj(2, 2) = 0.0_dp
2629 dxpndxj(2, 3) = -1.0_dp*xpkj1(1) + xpij1(1)
2630 dxpndxj(3, 1) = -1.0_dp*xpkj1(2) + xpij1(2)
2631 dxpndxj(3, 2) = -1.0_dp*xpij1(1) + xpkj1(1)
2632 dxpndxj(3, 3) = 0.0_dp
2633 !
2634 dxpndxk(1, 1) = 0.0_dp
2635 dxpndxk(1, 2) = -1.0_dp*xpij1(3)
2636 dxpndxk(1, 3) = 1.0_dp*xpij1(2)
2637 dxpndxk(2, 1) = 1.0_dp*xpij1(3)
2638 dxpndxk(2, 2) = 0.0_dp
2639 dxpndxk(2, 3) = -1.0_dp*xpij1(1)
2640 dxpndxk(3, 1) = -1.0_dp*xpij1(2)
2641 dxpndxk(3, 2) = 1.0_dp*xpij1(1)
2642 dxpndxk(3, 3) = 0.0_dp
2643 !
2644 fi = matmul(dsdxpn, dxpndxi)
2645 fj = matmul(dsdxpn, dxpndxj)
2646 fk = matmul(dsdxpn, dxpndxk)
2647
2648 ! Transfer derivatives on atoms
2649 CALL put_derivative(colvar, np + 1, fi)
2650 CALL put_derivative(colvar, np + 2, fj)
2651 CALL put_derivative(colvar, np + 3, fk)
2652 END IF
2653
2654 END SUBROUTINE plane_plane_angle_colvar
2655
2656! **************************************************************************************************
2657!> \brief Evaluates the value of the rotation angle between two bonds
2658!> \param colvar ...
2659!> \param cell ...
2660!> \param subsys ...
2661!> \param particles ...
2662!> \author Teodoro Laino 02.2006 [created]
2663! **************************************************************************************************
2664 SUBROUTINE rotation_colvar(colvar, cell, subsys, particles)
2665 TYPE(colvar_type), POINTER :: colvar
2666 TYPE(cell_type), POINTER :: cell
2667 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2668 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2669 POINTER :: particles
2670
2671 INTEGER :: i, idum
2672 REAL(dp) :: a, b, fmod, t0, t1, t2, t3, xdum(3), &
2673 xij(3), xkj(3)
2674 REAL(kind=dp) :: dp1b1(3), dp1b2(3), dp2b1(3), dp2b2(3), &
2675 ss(3), xp1b1(3), xp1b2(3), xp2b1(3), &
2676 xp2b2(3)
2677 TYPE(particle_list_type), POINTER :: particles_i
2678 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2679
2680 NULLIFY (particles_i)
2681
2682 cpassert(colvar%type_id == rotation_colvar_id)
2683 IF (PRESENT(particles)) THEN
2684 my_particles => particles
2685 ELSE
2686 cpassert(PRESENT(subsys))
2687 CALL cp_subsys_get(subsys, particles=particles_i)
2688 my_particles => particles_i%els
2689 END IF
2690 i = colvar%rotation_param%i_at1_bond1
2691 CALL get_coordinates(colvar, i, xp1b1, my_particles)
2692 i = colvar%rotation_param%i_at2_bond1
2693 CALL get_coordinates(colvar, i, xp2b1, my_particles)
2694 i = colvar%rotation_param%i_at1_bond2
2695 CALL get_coordinates(colvar, i, xp1b2, my_particles)
2696 i = colvar%rotation_param%i_at2_bond2
2697 CALL get_coordinates(colvar, i, xp2b2, my_particles)
2698 ! xij
2699 ss = matmul(cell%h_inv, xp1b1 - xp2b1)
2700 ss = ss - nint(ss)
2701 xij = matmul(cell%hmat, ss)
2702 ! xkj
2703 ss = matmul(cell%h_inv, xp1b2 - xp2b2)
2704 ss = ss - nint(ss)
2705 xkj = matmul(cell%hmat, ss)
2706 ! evaluation of the angle..
2707 a = norm2(xij)
2708 b = norm2(xkj)
2709 t0 = 1.0_dp/(a*b)
2710 t1 = 1.0_dp/(a**3.0_dp*b)
2711 t2 = 1.0_dp/(a*b**3.0_dp)
2712 t3 = dot_product(xij, xkj)
2713 colvar%ss = acos(t3*t0)
2714 IF ((abs(colvar%ss) < tolerance_acos) .OR. (abs(colvar%ss - pi) < tolerance_acos)) THEN
2715 fmod = 0.0_dp
2716 ELSE
2717 fmod = -1.0_dp/sin(colvar%ss)
2718 END IF
2719 dp1b1 = xkj(:)*t0 - xij(:)*t1*t3
2720 dp2b1 = -xkj(:)*t0 + xij(:)*t1*t3
2721 dp1b2 = xij(:)*t0 - xkj(:)*t2*t3
2722 dp2b2 = -xij(:)*t0 + xkj(:)*t2*t3
2723
2724 xdum = dp1b1*fmod
2725 idum = colvar%rotation_param%i_at1_bond1
2726 CALL put_derivative(colvar, idum, xdum)
2727 xdum = dp2b1*fmod
2728 idum = colvar%rotation_param%i_at2_bond1
2729 CALL put_derivative(colvar, idum, xdum)
2730 xdum = dp1b2*fmod
2731 idum = colvar%rotation_param%i_at1_bond2
2732 CALL put_derivative(colvar, idum, xdum)
2733 xdum = dp2b2*fmod
2734 idum = colvar%rotation_param%i_at2_bond2
2735 CALL put_derivative(colvar, idum, xdum)
2736
2737 END SUBROUTINE rotation_colvar
2738
2739! **************************************************************************************************
2740!> \brief evaluates the force due to the function of two distances
2741!> \param colvar ...
2742!> \param cell ...
2743!> \param subsys ...
2744!> \param particles ...
2745!> \author Teodoro Laino 02.2006 [created]
2746!> \note modified Florian Schiffmann 08.2008
2747! **************************************************************************************************
2748 SUBROUTINE dfunct_colvar(colvar, cell, subsys, particles)
2749 TYPE(colvar_type), POINTER :: colvar
2750 TYPE(cell_type), POINTER :: cell
2751 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2752 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2753 POINTER :: particles
2754
2755 INTEGER :: i, j, k, l
2756 REAL(dp) :: fi(3), fj(3), fk(3), fl(3), r12, r34, &
2757 ss(3), xij(3), xkl(3), xpi(3), xpj(3), &
2758 xpk(3), xpl(3)
2759 TYPE(particle_list_type), POINTER :: particles_i
2760 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2761
2762 NULLIFY (particles_i)
2763
2764 cpassert(colvar%type_id == dfunct_colvar_id)
2765 IF (PRESENT(particles)) THEN
2766 my_particles => particles
2767 ELSE
2768 cpassert(PRESENT(subsys))
2769 CALL cp_subsys_get(subsys, particles=particles_i)
2770 my_particles => particles_i%els
2771 END IF
2772 i = colvar%dfunct_param%i_at_dfunct(1)
2773 j = colvar%dfunct_param%i_at_dfunct(2)
2774 ! First bond
2775 CALL get_coordinates(colvar, i, xpi, my_particles)
2776 CALL get_coordinates(colvar, j, xpj, my_particles)
2777 IF (colvar%dfunct_param%use_pbc) THEN
2778 ss = matmul(cell%h_inv, xpi - xpj)
2779 ss = ss - nint(ss)
2780 xij = matmul(cell%hmat, ss)
2781 ELSE
2782 xij = xpi - xpj
2783 END IF
2784 r12 = sqrt(xij(1)**2 + xij(2)**2 + xij(3)**2)
2785 ! Second bond
2786 k = colvar%dfunct_param%i_at_dfunct(3)
2787 l = colvar%dfunct_param%i_at_dfunct(4)
2788 CALL get_coordinates(colvar, k, xpk, my_particles)
2789 CALL get_coordinates(colvar, l, xpl, my_particles)
2790 IF (colvar%dfunct_param%use_pbc) THEN
2791 ss = matmul(cell%h_inv, xpk - xpl)
2792 ss = ss - nint(ss)
2793 xkl = matmul(cell%hmat, ss)
2794 ELSE
2795 xkl = xpk - xpl
2796 END IF
2797 r34 = sqrt(xkl(1)**2 + xkl(2)**2 + xkl(3)**2)
2798 !
2799 colvar%ss = r12 + colvar%dfunct_param%coeff*r34
2800 fi(:) = xij/r12
2801 fj(:) = -xij/r12
2802 fk(:) = colvar%dfunct_param%coeff*xkl/r34
2803 fl(:) = -colvar%dfunct_param%coeff*xkl/r34
2804 CALL put_derivative(colvar, 1, fi)
2805 CALL put_derivative(colvar, 2, fj)
2806 CALL put_derivative(colvar, 3, fk)
2807 CALL put_derivative(colvar, 4, fl)
2808
2809 END SUBROUTINE dfunct_colvar
2810
2811! **************************************************************************************************
2812!> \brief evaluates the force due (and on) the distance from the plane collective variable
2813!> \param colvar ...
2814!> \param cell ...
2815!> \param subsys ...
2816!> \param particles ...
2817!> \author Teodoro Laino 02.2006 [created]
2818! **************************************************************************************************
2819 SUBROUTINE angle_colvar(colvar, cell, subsys, particles)
2820 TYPE(colvar_type), POINTER :: colvar
2821 TYPE(cell_type), POINTER :: cell
2822 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2823 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2824 POINTER :: particles
2825
2826 INTEGER :: i, j, k
2827 REAL(dp) :: a, b, fi(3), fj(3), fk(3), fmod, ri(3), &
2828 rj(3), rk(3), ss(3), t0, t1, t2, t3, &
2829 xij(3), xkj(3)
2830 TYPE(particle_list_type), POINTER :: particles_i
2831 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2832
2833 NULLIFY (particles_i)
2834
2835 cpassert(colvar%type_id == angle_colvar_id)
2836 IF (PRESENT(particles)) THEN
2837 my_particles => particles
2838 ELSE
2839 cpassert(PRESENT(subsys))
2840 CALL cp_subsys_get(subsys, particles=particles_i)
2841 my_particles => particles_i%els
2842 END IF
2843 i = colvar%angle_param%i_at_angle(1)
2844 j = colvar%angle_param%i_at_angle(2)
2845 k = colvar%angle_param%i_at_angle(3)
2846 CALL get_coordinates(colvar, i, ri, my_particles)
2847 CALL get_coordinates(colvar, j, rj, my_particles)
2848 CALL get_coordinates(colvar, k, rk, my_particles)
2849 ! xij
2850 ss = matmul(cell%h_inv, ri - rj)
2851 ss = ss - nint(ss)
2852 xij = matmul(cell%hmat, ss)
2853 ! xkj
2854 ss = matmul(cell%h_inv, rk - rj)
2855 ss = ss - nint(ss)
2856 xkj = matmul(cell%hmat, ss)
2857 ! Evaluation of the angle..
2858 a = norm2(xij)
2859 b = norm2(xkj)
2860 t0 = 1.0_dp/(a*b)
2861 t1 = 1.0_dp/(a**3.0_dp*b)
2862 t2 = 1.0_dp/(a*b**3.0_dp)
2863 t3 = dot_product(xij, xkj)
2864 colvar%ss = acos(t3*t0)
2865 IF ((abs(colvar%ss) < tolerance_acos) .OR. (abs(colvar%ss - pi) < tolerance_acos)) THEN
2866 fmod = 0.0_dp
2867 ELSE
2868 fmod = -1.0_dp/sin(colvar%ss)
2869 END IF
2870 fi(:) = xkj(:)*t0 - xij(:)*t1*t3
2871 fj(:) = -xkj(:)*t0 + xij(:)*t1*t3 - xij(:)*t0 + xkj(:)*t2*t3
2872 fk(:) = xij(:)*t0 - xkj(:)*t2*t3
2873 fi = fi*fmod
2874 fj = fj*fmod
2875 fk = fk*fmod
2876 CALL put_derivative(colvar, 1, fi)
2877 CALL put_derivative(colvar, 2, fj)
2878 CALL put_derivative(colvar, 3, fk)
2879
2880 END SUBROUTINE angle_colvar
2881
2882! **************************************************************************************************
2883!> \brief evaluates the force due (and on) the distance collective variable
2884!> \param colvar ...
2885!> \param cell ...
2886!> \param subsys ...
2887!> \param particles ...
2888!> \author Alessandro Laio, Fawzi Mohamed
2889! **************************************************************************************************
2890 SUBROUTINE dist_colvar(colvar, cell, subsys, particles)
2891 TYPE(colvar_type), POINTER :: colvar
2892 TYPE(cell_type), POINTER :: cell
2893 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2894 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2895 POINTER :: particles
2896
2897 INTEGER :: i, j
2898 REAL(dp) :: fi(3), fj(3), r12, ss(3), xij(3), &
2899 xpi(3), xpj(3)
2900 TYPE(particle_list_type), POINTER :: particles_i
2901 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2902
2903 NULLIFY (particles_i)
2904
2905 cpassert(colvar%type_id == dist_colvar_id)
2906 IF (PRESENT(particles)) THEN
2907 my_particles => particles
2908 ELSE
2909 cpassert(PRESENT(subsys))
2910 CALL cp_subsys_get(subsys, particles=particles_i)
2911 my_particles => particles_i%els
2912 END IF
2913 i = colvar%dist_param%i_at
2914 j = colvar%dist_param%j_at
2915 CALL get_coordinates(colvar, i, xpi, my_particles)
2916 CALL get_coordinates(colvar, j, xpj, my_particles)
2917 ss = matmul(cell%h_inv, xpi - xpj)
2918 ss = ss - nint(ss)
2919 xij = matmul(cell%hmat, ss)
2920 SELECT CASE (colvar%dist_param%axis_id)
2921 CASE (do_clv_x)
2922 xij(2) = 0.0_dp
2923 xij(3) = 0.0_dp
2924 CASE (do_clv_y)
2925 xij(1) = 0.0_dp
2926 xij(3) = 0.0_dp
2927 CASE (do_clv_z)
2928 xij(1) = 0.0_dp
2929 xij(2) = 0.0_dp
2930 CASE (do_clv_xy)
2931 xij(3) = 0.0_dp
2932 CASE (do_clv_xz)
2933 xij(2) = 0.0_dp
2934 CASE (do_clv_yz)
2935 xij(1) = 0.0_dp
2936 CASE DEFAULT
2937 !do_clv_xyz
2938 END SELECT
2939 r12 = sqrt(xij(1)**2 + xij(2)**2 + xij(3)**2)
2940
2941 IF (colvar%dist_param%sign_d) THEN
2942 SELECT CASE (colvar%dist_param%axis_id)
2943 CASE (do_clv_x)
2944 colvar%ss = xij(1)
2945 CASE (do_clv_y)
2946 colvar%ss = xij(2)
2947 CASE (do_clv_z)
2948 colvar%ss = xij(3)
2949 CASE DEFAULT
2950 !do_clv_xyz
2951 END SELECT
2952
2953 ELSE
2954 colvar%ss = r12
2955 END IF
2956
2957 fi(:) = xij/r12
2958 fj(:) = -xij/r12
2959
2960 CALL put_derivative(colvar, 1, fi)
2961 CALL put_derivative(colvar, 2, fj)
2962
2963 END SUBROUTINE dist_colvar
2964
2965! **************************************************************************************************
2966!> \brief evaluates the force due to the torsion collective variable
2967!> \param colvar ...
2968!> \param cell ...
2969!> \param subsys ...
2970!> \param particles ...
2971!> \param no_riemann_sheet_op ...
2972!> \author Alessandro Laio, Fawzi Mohamed
2973! **************************************************************************************************
2974 SUBROUTINE torsion_colvar(colvar, cell, subsys, particles, no_riemann_sheet_op)
2975
2976 TYPE(colvar_type), POINTER :: colvar
2977 TYPE(cell_type), POINTER :: cell
2978 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
2979 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
2980 POINTER :: particles
2981 LOGICAL, INTENT(IN), OPTIONAL :: no_riemann_sheet_op
2982
2983 INTEGER :: i, ii
2984 LOGICAL :: no_riemann_sheet
2985 REAL(dp) :: angle, cosine, dedphi, dedxia, dedxib, dedxic, dedxid, dedxt, dedxu, dedyia, &
2986 dedyib, dedyic, dedyid, dedyt, dedyu, dedzia, dedzib, dedzic, dedzid, dedzt, dedzu, dt, &
2987 e, ftmp(3), o0, rcb, rt2, rtmp(3), rtru, ru2, sine, ss(3), xba, xca, xcb, xdb, xdc, xt, &
2988 xtu, xu, yba, yca, ycb, ydb, ydc, yt, ytu, yu, zba, zca, zcb, zdb, zdc, zt, ztu, zu
2989 REAL(dp), DIMENSION(3, 4) :: rr
2990 TYPE(particle_list_type), POINTER :: particles_i
2991 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
2992
2993 NULLIFY (particles_i)
2994 cpassert(colvar%type_id == torsion_colvar_id)
2995 IF (PRESENT(particles)) THEN
2996 my_particles => particles
2997 ELSE
2998 cpassert(PRESENT(subsys))
2999 CALL cp_subsys_get(subsys, particles=particles_i)
3000 my_particles => particles_i%els
3001 END IF
3002 no_riemann_sheet = .false.
3003 IF (PRESENT(no_riemann_sheet_op)) no_riemann_sheet = no_riemann_sheet_op
3004 DO ii = 1, 4
3005 i = colvar%torsion_param%i_at_tors(ii)
3006 CALL get_coordinates(colvar, i, rtmp, my_particles)
3007 rr(:, ii) = rtmp(1:3)
3008 END DO
3009 o0 = colvar%torsion_param%o0
3010 ! ba
3011 ss = matmul(cell%h_inv, rr(:, 2) - rr(:, 1))
3012 ss = ss - nint(ss)
3013 ss = matmul(cell%hmat, ss)
3014 xba = ss(1)
3015 yba = ss(2)
3016 zba = ss(3)
3017 ! cb
3018 ss = matmul(cell%h_inv, rr(:, 3) - rr(:, 2))
3019 ss = ss - nint(ss)
3020 ss = matmul(cell%hmat, ss)
3021 xcb = ss(1)
3022 ycb = ss(2)
3023 zcb = ss(3)
3024 ! dc
3025 ss = matmul(cell%h_inv, rr(:, 4) - rr(:, 3))
3026 ss = ss - nint(ss)
3027 ss = matmul(cell%hmat, ss)
3028 xdc = ss(1)
3029 ydc = ss(2)
3030 zdc = ss(3)
3031 !
3032 xt = yba*zcb - ycb*zba
3033 yt = zba*xcb - zcb*xba
3034 zt = xba*ycb - xcb*yba
3035 xu = ycb*zdc - ydc*zcb
3036 yu = zcb*xdc - zdc*xcb
3037 zu = xcb*ydc - xdc*ycb
3038 xtu = yt*zu - yu*zt
3039 ytu = zt*xu - zu*xt
3040 ztu = xt*yu - xu*yt
3041 rt2 = xt*xt + yt*yt + zt*zt
3042 ru2 = xu*xu + yu*yu + zu*zu
3043 rtru = sqrt(rt2*ru2)
3044 IF (rtru /= 0.0_dp) THEN
3045 rcb = sqrt(xcb*xcb + ycb*ycb + zcb*zcb)
3046 cosine = (xt*xu + yt*yu + zt*zu)/rtru
3047 sine = (xcb*xtu + ycb*ytu + zcb*ztu)/(rcb*rtru)
3048 cosine = min(1.0_dp, max(-1.0_dp, cosine))
3049 angle = acos(cosine)
3050 IF (sine < 0.0_dp) angle = -angle
3051 !
3052 dt = angle ! [rad]
3053 dt = mod(2.0e4_dp*pi + dt - o0, 2.0_dp*pi)
3054 IF (dt > pi) dt = dt - 2.0_dp*pi
3055 dt = o0 + dt
3056 colvar%torsion_param%o0 = dt
3057 !
3058 ! calculate improper energy and master chain rule term
3059 !
3060 e = dt
3061 dedphi = 1.0_dp
3062 !
3063 ! chain rule terms for first derivative components
3064 !
3065 ! ca
3066 ss = matmul(cell%h_inv, rr(:, 3) - rr(:, 1))
3067 ss = ss - nint(ss)
3068 ss = matmul(cell%hmat, ss)
3069 xca = ss(1)
3070 yca = ss(2)
3071 zca = ss(3)
3072 ! db
3073 ss = matmul(cell%h_inv, rr(:, 4) - rr(:, 2))
3074 ss = ss - nint(ss)
3075 ss = matmul(cell%hmat, ss)
3076 xdb = ss(1)
3077 ydb = ss(2)
3078 zdb = ss(3)
3079 !
3080 dedxt = dedphi*(yt*zcb - ycb*zt)/(rt2*rcb)
3081 dedyt = dedphi*(zt*xcb - zcb*xt)/(rt2*rcb)
3082 dedzt = dedphi*(xt*ycb - xcb*yt)/(rt2*rcb)
3083 dedxu = -dedphi*(yu*zcb - ycb*zu)/(ru2*rcb)
3084 dedyu = -dedphi*(zu*xcb - zcb*xu)/(ru2*rcb)
3085 dedzu = -dedphi*(xu*ycb - xcb*yu)/(ru2*rcb)
3086 !
3087 ! compute first derivative components for this angle
3088 !
3089 dedxia = zcb*dedyt - ycb*dedzt
3090 dedyia = xcb*dedzt - zcb*dedxt
3091 dedzia = ycb*dedxt - xcb*dedyt
3092 dedxib = yca*dedzt - zca*dedyt + zdc*dedyu - ydc*dedzu
3093 dedyib = zca*dedxt - xca*dedzt + xdc*dedzu - zdc*dedxu
3094 dedzib = xca*dedyt - yca*dedxt + ydc*dedxu - xdc*dedyu
3095 dedxic = zba*dedyt - yba*dedzt + ydb*dedzu - zdb*dedyu
3096 dedyic = xba*dedzt - zba*dedxt + zdb*dedxu - xdb*dedzu
3097 dedzic = yba*dedxt - xba*dedyt + xdb*dedyu - ydb*dedxu
3098 dedxid = zcb*dedyu - ycb*dedzu
3099 dedyid = xcb*dedzu - zcb*dedxu
3100 dedzid = ycb*dedxu - xcb*dedyu
3101 ELSE
3102 dedxia = 0.0_dp
3103 dedyia = 0.0_dp
3104 dedzia = 0.0_dp
3105 dedxib = 0.0_dp
3106 dedyib = 0.0_dp
3107 dedzib = 0.0_dp
3108 dedxic = 0.0_dp
3109 dedyic = 0.0_dp
3110 dedzic = 0.0_dp
3111 dedxid = 0.0_dp
3112 dedyid = 0.0_dp
3113 dedzid = 0.0_dp
3114 END IF
3115 !
3116 colvar%ss = e
3117 IF (no_riemann_sheet) colvar%ss = atan2(sin(e), cos(e))
3118 ftmp(1) = dedxia
3119 ftmp(2) = dedyia
3120 ftmp(3) = dedzia
3121 CALL put_derivative(colvar, 1, ftmp)
3122 ftmp(1) = dedxib
3123 ftmp(2) = dedyib
3124 ftmp(3) = dedzib
3125 CALL put_derivative(colvar, 2, ftmp)
3126 ftmp(1) = dedxic
3127 ftmp(2) = dedyic
3128 ftmp(3) = dedzic
3129 CALL put_derivative(colvar, 3, ftmp)
3130 ftmp(1) = dedxid
3131 ftmp(2) = dedyid
3132 ftmp(3) = dedzid
3133 CALL put_derivative(colvar, 4, ftmp)
3134 END SUBROUTINE torsion_colvar
3135
3136! **************************************************************************************************
3137!> \brief evaluates the force due (and on) the Q PARM collective variable
3138!> \param colvar ...
3139!> \param cell ...
3140!> \param subsys ...
3141!> \param particles ...
3142! **************************************************************************************************
3143 SUBROUTINE qparm_colvar(colvar, cell, subsys, particles)
3144 TYPE(colvar_type), POINTER :: colvar
3145 TYPE(cell_type), POINTER :: cell
3146 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
3147 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
3148 POINTER :: particles
3149
3150 INTEGER :: aa, bb, cc, i, idim, ii, j, jj, l, mm, &
3151 n_atoms_from, n_atoms_to, ncells(3)
3152 LOGICAL :: include_images
3153 REAL(kind=dp) :: denominator_tolerance, fact, ftmp(3), im_qlm, inv_n_atoms_from, nbond, &
3154 pre_fac, ql, qparm, r1cut, rcut, re_qlm, rij, rij_shift, shift(3), ss(3), ss0(3), xij(3), &
3155 xij_shift(3)
3156 REAL(kind=dp), DIMENSION(3) :: d_im_qlm_dxi, d_nbond_dxi, d_ql_dxi, &
3157 d_re_qlm_dxi, xpi, xpj
3158 TYPE(particle_list_type), POINTER :: particles_i
3159 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
3160
3161 n_atoms_to = colvar%qparm_param%n_atoms_to
3162 n_atoms_from = colvar%qparm_param%n_atoms_from
3163 rcut = colvar%qparm_param%rcut
3164 l = colvar%qparm_param%l
3165 r1cut = colvar%qparm_param%rstart
3166 include_images = colvar%qparm_param%include_images
3167 NULLIFY (particles_i)
3168 cpassert(colvar%type_id == qparm_colvar_id)
3169 IF (PRESENT(particles)) THEN
3170 my_particles => particles
3171 ELSE
3172 cpassert(PRESENT(subsys))
3173 CALL cp_subsys_get(subsys, particles=particles_i)
3174 my_particles => particles_i%els
3175 END IF
3176 cpassert(r1cut < rcut)
3177 denominator_tolerance = 1.0e-8_dp
3178
3179 qparm = 0.0_dp
3180 inv_n_atoms_from = 1.0_dp/real(n_atoms_from, kind=dp)
3181 DO ii = 1, n_atoms_from
3182 i = colvar%qparm_param%i_at_from(ii)
3183 CALL get_coordinates(colvar, i, xpi, my_particles)
3184 !xpi(1)=xpi(1)+idel*ri_step
3185 ql = 0.0_dp
3186 d_ql_dxi(:) = 0.0_dp
3187
3188 DO mm = -l, l
3189 nbond = 0.0_dp
3190 re_qlm = 0.0_dp
3191 im_qlm = 0.0_dp
3192 d_re_qlm_dxi(:) = 0.0_dp
3193 d_im_qlm_dxi(:) = 0.0_dp
3194 d_nbond_dxi(:) = 0.0_dp
3195
3196 jloop: DO jj = 1, n_atoms_to
3197
3198 j = colvar%qparm_param%i_at_to(jj)
3199 CALL get_coordinates(colvar, j, xpj, my_particles)
3200
3201 IF (include_images) THEN
3202
3203 cpassert(cell%orthorhombic)
3204
3205 ! determine how many cells must be included in each direction
3206 ! based on rcut
3207 xij(:) = xpj(:) - xpi(:)
3208 ss = matmul(cell%h_inv, xij)
3209 ! these are fractional coordinates of the closest periodic image
3210 ! lie in the [-0.5,0.5] interval
3211 ss0 = ss - nint(ss)
3212 DO idim = 1, 3
3213 shift(:) = 0.0_dp
3214 shift(idim) = 1.0_dp
3215 xij_shift = matmul(cell%hmat, shift)
3216 rij_shift = norm2(xij_shift)
3217 ncells(idim) = floor(rcut/rij_shift - 0.5)
3218 END DO !idim
3219
3220 shift(1:3) = 0.0_dp
3221 DO aa = -ncells(1), ncells(1)
3222 DO bb = -ncells(2), ncells(2)
3223 DO cc = -ncells(3), ncells(3)
3224 ! do not include the central atom
3225 IF (i == j .AND. aa == 0 .AND. bb == 0 .AND. cc == 0) cycle
3226 shift(1) = real(aa, kind=dp)
3227 shift(2) = real(bb, kind=dp)
3228 shift(3) = real(cc, kind=dp)
3229 xij = matmul(cell%hmat, ss0(:) + shift(:))
3230 rij = norm2(xij)
3231 IF (rij > rcut) cycle
3232
3233 ! update qlm
3234 CALL accumulate_qlm_over_neigbors(xij, rij, rcut, r1cut, &
3235 denominator_tolerance, l, mm, nbond, re_qlm, im_qlm, &
3236 d_re_qlm_dxi, d_im_qlm_dxi, d_nbond_dxi)
3237
3238 END DO
3239 END DO
3240 END DO
3241
3242 ELSE
3243
3244 IF (i == j) cycle jloop
3245 xij(:) = xpj(:) - xpi(:)
3246 rij = norm2(xij)
3247 IF (rij > rcut) cycle jloop
3248
3249 ! update qlm
3250 CALL accumulate_qlm_over_neigbors(xij, rij, rcut, r1cut, &
3251 denominator_tolerance, l, mm, nbond, re_qlm, im_qlm, &
3252 d_re_qlm_dxi, d_im_qlm_dxi, d_nbond_dxi)
3253
3254 END IF ! include images
3255
3256 END DO jloop
3257
3258 ! this factor is necessary if one whishes to sum over m=0,L
3259 ! instead of m=-L,+L. This is off now because it is cheap and safe
3260 fact = 1.0_dp
3261
3262 IF (nbond < denominator_tolerance) THEN
3263 cpwarn("QPARM: number of neighbors is very close to zero!")
3264 END IF
3265
3266 d_nbond_dxi(:) = d_nbond_dxi(:)/nbond
3267 re_qlm = re_qlm/nbond
3268 d_re_qlm_dxi(:) = d_re_qlm_dxi(:)/nbond - d_nbond_dxi(:)*re_qlm
3269 im_qlm = im_qlm/nbond
3270 d_im_qlm_dxi(:) = d_im_qlm_dxi(:)/nbond - d_nbond_dxi(:)*im_qlm
3271
3272 ql = ql + fact*(re_qlm*re_qlm + im_qlm*im_qlm)
3273 d_ql_dxi(:) = d_ql_dxi(:) &
3274 + fact*2.0_dp*(re_qlm*d_re_qlm_dxi(:) + im_qlm*d_im_qlm_dxi(:))
3275
3276 END DO ! loop over m
3277
3278 pre_fac = (4.0_dp*pi)/(2.0_dp*l + 1)
3279 qparm = qparm + sqrt(pre_fac*ql)
3280 ftmp(:) = 0.5_dp*sqrt(pre_fac/ql)*d_ql_dxi(:)
3281 ! multiply by -1 because aparently we have to save the force, not the gradient
3282 ftmp(:) = -1.0_dp*ftmp(:)
3283
3284 CALL put_derivative(colvar, ii, ftmp)
3285
3286 END DO ! loop over i
3287
3288 colvar%ss = qparm*inv_n_atoms_from
3289 colvar%dsdr(:, :) = colvar%dsdr(:, :)*inv_n_atoms_from
3290
3291 END SUBROUTINE qparm_colvar
3292
3293! **************************************************************************************************
3294!> \brief ...
3295!> \param xij ...
3296!> \param rij ...
3297!> \param rcut ...
3298!> \param r1cut ...
3299!> \param denominator_tolerance ...
3300!> \param ll ...
3301!> \param mm ...
3302!> \param nbond ...
3303!> \param re_qlm ...
3304!> \param im_qlm ...
3305!> \param d_re_qlm_dxi ...
3306!> \param d_im_qlm_dxi ...
3307!> \param d_nbond_dxi ...
3308! **************************************************************************************************
3309 SUBROUTINE accumulate_qlm_over_neigbors(xij, rij, rcut, r1cut, &
3310 denominator_tolerance, ll, mm, nbond, re_qlm, im_qlm, &
3311 d_re_qlm_dxi, d_im_qlm_dxi, d_nbond_dxi)
3312
3313 REAL(kind=dp), INTENT(IN) :: xij(3), rij, rcut, r1cut, &
3314 denominator_tolerance
3315 INTEGER, INTENT(IN) :: ll, mm
3316 REAL(kind=dp), INTENT(INOUT) :: nbond, re_qlm, im_qlm, d_re_qlm_dxi(3), &
3317 d_im_qlm_dxi(3), d_nbond_dxi(3)
3318
3319 REAL(kind=dp) :: bond, costheta, dplm, dylm, exp0, &
3320 exp_fac, fi, plm, pre_fac, sqrt_c1
3321 REAL(kind=dp), DIMENSION(3) :: dcostheta, dfi
3322
3323 ! RZK: infinitely differentiable smooth cutoff function
3324 ! that is precisely 1.0 below r1cut and precisely 0.0 above rcut
3325 IF (rij > rcut) THEN
3326 !bond = 0.0_dp
3327 !exp_fac = 0.0_dp
3328 RETURN
3329 ELSE
3330 IF (rij < r1cut) THEN
3331 bond = 1.0_dp
3332 exp_fac = 0.0_dp
3333 ELSE
3334 exp0 = exp((r1cut - rcut)/(rij - rcut) - (r1cut - rcut)/(r1cut - rij))
3335 bond = 1.0_dp/(1.0_dp + exp0)
3336 exp_fac = ((rcut - r1cut)/(rij - rcut)**2 + (rcut - r1cut)/(r1cut - rij)**2)*exp0/(1.0_dp + exp0)**2
3337 END IF
3338 END IF
3339 IF (bond > 1.0_dp) THEN
3340 cpabort("bond > 1.0_dp")
3341 END IF
3342 ! compute continuous bond order
3343 nbond = nbond + bond
3344 IF (abs(xij(1)) < denominator_tolerance &
3345 .AND. abs(xij(2)) < denominator_tolerance) THEN
3346 fi = 0.0_dp
3347 ELSE
3348 fi = atan2(xij(2), xij(1))
3349 END IF
3350
3351 costheta = xij(3)/rij
3352 IF (costheta > 1.0_dp) costheta = 1.0_dp
3353 IF (costheta < -1.0_dp) costheta = -1.0_dp
3354
3355 ! legendre works correctly only for positive m
3356 plm = legendre(costheta, ll, mm)
3357 dplm = dlegendre(costheta, ll, mm)
3358 IF ((ll + abs(mm)) > maxfac) THEN
3359 cpabort("(l+m) > maxfac")
3360 END IF
3361 ! use absolute m to compenstate for the defficiency of legendre
3362 sqrt_c1 = sqrt(((2*ll + 1)*fac(ll - abs(mm)))/(4*pi*fac(ll + abs(mm))))
3363 pre_fac = bond*sqrt_c1
3364 dylm = pre_fac*dplm
3365
3366 re_qlm = re_qlm + pre_fac*plm*cos(mm*fi)
3367 im_qlm = im_qlm + pre_fac*plm*sin(mm*fi)
3368
3369 dcostheta(:) = xij(:)*xij(3)/(rij**3)
3370 dcostheta(3) = dcostheta(3) - 1.0_dp/rij
3371 ! use tangent half-angle formula to compute d_fi/d_xi
3372 ! http://math.stackexchange.com/questions/989877/continuous-differentiability-of-atan2
3373 ! +/- sign changed because xij = xj - xi
3374 dfi(1) = xij(2)/(xij(1)**2 + xij(2)**2)
3375 dfi(2) = -xij(1)/(xij(1)**2 + xij(2)**2)
3376 dfi(3) = 0.0_dp
3377 d_re_qlm_dxi(:) = d_re_qlm_dxi(:) &
3378 + exp_fac*sqrt_c1*plm*cos(mm*fi)*xij(:)/rij &
3379 + dylm*dcostheta(:)*cos(mm*fi) &
3380 + pre_fac*plm*mm*(-1.0_dp)*sin(mm*fi)*dfi(:)
3381 d_im_qlm_dxi(:) = d_im_qlm_dxi(:) &
3382 + exp_fac*sqrt_c1*plm*sin(mm*fi)*xij(:)/rij &
3383 + dylm*dcostheta(:)*sin(mm*fi) &
3384 + pre_fac*plm*mm*(+1.0_dp)*cos(mm*fi)*dfi(:)
3385 d_nbond_dxi(:) = d_nbond_dxi(:) + exp_fac*xij(:)/rij
3386
3387 END SUBROUTINE accumulate_qlm_over_neigbors
3388
3389! **************************************************************************************************
3390!> \brief evaluates the force due (and on) the hydronium_shell collective variable
3391!> \param colvar ...
3392!> \param cell ...
3393!> \param subsys ...
3394!> \param particles ...
3395!> \author Marcel Baer
3396!> \note This function needs to be extended to the POINT structure!!
3397!> non-standard conform.. it's a breach in the colvar module.
3398! **************************************************************************************************
3399 SUBROUTINE hydronium_shell_colvar(colvar, cell, subsys, particles)
3400 TYPE(colvar_type), POINTER :: colvar
3401 TYPE(cell_type), POINTER :: cell
3402 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
3403 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
3404 POINTER :: particles
3405
3406 INTEGER :: i, ii, j, jj, n_hydrogens, n_oxygens, &
3407 pm, poh, poo, qm, qoh, qoo
3408 REAL(dp) :: drji, fscalar, invden, lambda, nh, num, &
3409 qtot, rji(3), roh, roo, rrel
3410 REAL(dp), ALLOCATABLE, DIMENSION(:) :: m, noh, noo, qloc
3411 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: dm, dnoh, dnoo
3412 REAL(dp), DIMENSION(3) :: rpi, rpj
3413 TYPE(particle_list_type), POINTER :: particles_i
3414 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
3415
3416 n_oxygens = colvar%hydronium_shell_param%n_oxygens
3417 n_hydrogens = colvar%hydronium_shell_param%n_hydrogens
3418 nh = colvar%hydronium_shell_param%nh
3419 poh = colvar%hydronium_shell_param%poh
3420 qoh = colvar%hydronium_shell_param%qoh
3421 poo = colvar%hydronium_shell_param%poo
3422 qoo = colvar%hydronium_shell_param%qoo
3423 roo = colvar%hydronium_shell_param%roo
3424 roh = colvar%hydronium_shell_param%roh
3425 lambda = colvar%hydronium_shell_param%lambda
3426 pm = colvar%hydronium_shell_param%pm
3427 qm = colvar%hydronium_shell_param%qm
3428
3429 NULLIFY (particles_i)
3430 cpassert(colvar%type_id == hydronium_shell_colvar_id)
3431 IF (PRESENT(particles)) THEN
3432 my_particles => particles
3433 ELSE
3434 cpassert(PRESENT(subsys))
3435 CALL cp_subsys_get(subsys, particles=particles_i)
3436 my_particles => particles_i%els
3437 END IF
3438
3439 ALLOCATE (dnoh(3, n_hydrogens, n_oxygens))
3440 ALLOCATE (noh(n_oxygens))
3441 ALLOCATE (m(n_oxygens))
3442 ALLOCATE (dm(3, n_hydrogens, n_oxygens))
3443
3444 ALLOCATE (dnoo(3, n_oxygens, n_oxygens))
3445 ALLOCATE (noo(n_oxygens))
3446
3447 ALLOCATE (qloc(n_oxygens))
3448
3449 ! Zero Arrays:
3450 dnoh = 0._dp
3451 dnoo = 0._dp
3452 m = 0._dp
3453 dm = 0._dp
3454 noo = 0._dp
3455 qloc = 0._dp
3456 noh = 0._dp
3457 DO ii = 1, n_oxygens
3458 i = colvar%hydronium_shell_param%i_oxygens(ii)
3459 rpi(:) = my_particles(i)%r(1:3)
3460 ! Computing M( n ( ii ) )
3461 DO jj = 1, n_hydrogens
3462 j = colvar%hydronium_shell_param%i_hydrogens(jj)
3463 rpj(:) = my_particles(j)%r(1:3)
3464 rji = pbc(rpj, rpi, cell)
3465 drji = sqrt(sum(rji**2))
3466 rrel = drji/roh
3467 num = (1.0_dp - rrel**poh)
3468 invden = 1.0_dp/(1.0_dp - rrel**qoh)
3469 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
3470 noh(ii) = noh(ii) + num*invden
3471 fscalar = ((-poh*(rrel**(poh - 1))*invden) &
3472 + num*(invden)**2*qoh*(rrel**(qoh - 1)))/(drji*roh)
3473 dnoh(1:3, jj, ii) = rji(1:3)*fscalar
3474 ELSE
3475 !correct limit if rji --> roh
3476 noh(ii) = noh(ii) + real(poh, dp)/real(qoh, dp)
3477 fscalar = real(poh*(poh - qoh), dp)/(real(2*qoh, dp)*roh*drji)
3478 dnoh(1:3, jj, ii) = rji(1:3)*fscalar
3479 END IF
3480 END DO
3481 m(ii) = 1.0_dp - (1.0_dp - (noh(ii)/nh)**pm)/ &
3482 (1.0_dp - (noh(ii)/nh)**qm)
3483
3484 ! Computing no ( ii )
3485 DO jj = 1, n_oxygens
3486 IF (ii == jj) cycle
3487 j = colvar%hydronium_shell_param%i_oxygens(jj)
3488 rpj(:) = my_particles(j)%r(1:3)
3489 rji = pbc(rpj, rpi, cell)
3490 drji = sqrt(sum(rji**2))
3491 rrel = drji/roo
3492 num = (1.0_dp - rrel**poo)
3493 invden = 1.0_dp/(1.0_dp - rrel**qoo)
3494 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
3495 noo(ii) = noo(ii) + num*invden
3496 fscalar = ((-poo*(rrel**(poo - 1))*invden) &
3497 + num*(invden)**2*qoo*(rrel**(qoo - 1)))/(drji*roo)
3498 dnoo(1:3, jj, ii) = rji(1:3)*fscalar
3499 ELSE
3500 !correct limit if rji --> roo
3501 noo(ii) = noo(ii) + real(poo, dp)/real(qoo, dp)
3502 fscalar = real(poo*(poo - qoo), dp)/(real(2*qoo, dp)*roo*drji)
3503 dnoo(1:3, jj, ii) = rji(1:3)*fscalar
3504 END IF
3505 END DO
3506 END DO
3507
3508 ! computing qloc and Q
3509 qtot = 0._dp
3510 DO ii = 1, n_oxygens
3511 qloc(ii) = exp(lambda*m(ii)*noo(ii))
3512 qtot = qtot + qloc(ii)
3513 END DO
3514 ! compute forces
3515 DO ii = 1, n_oxygens
3516 ! Computing f_OH
3517 DO jj = 1, n_hydrogens
3518 dm(1:3, jj, ii) = (pm*((noh(ii)/nh)**(pm - 1))*dnoh(1:3, jj, ii))/nh/ &
3519 (1.0_dp - (noh(ii)/nh)**qm) - &
3520 (1.0_dp - (noh(ii)/nh)**pm)/ &
3521 ((1.0_dp - (noh(ii)/nh)**qm)**2)* &
3522 qm*dnoh(1:3, jj, ii)*(noh(ii)/nh)**(qm - 1)/nh
3523
3524 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) + qloc(ii)*dm(1:3, jj, ii)*noo(ii)/qtot
3525 colvar%dsdr(1:3, n_oxygens + jj) = colvar%dsdr(1:3, n_oxygens + jj) &
3526 - qloc(ii)*dm(1:3, jj, ii)*noo(ii)/qtot
3527 END DO
3528 ! Computing f_OO
3529 DO jj = 1, n_oxygens
3530 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) + qloc(ii)*m(ii)*dnoo(1:3, jj, ii)/qtot
3531 colvar%dsdr(1:3, jj) = colvar%dsdr(1:3, jj) &
3532 - qloc(ii)*m(ii)*dnoo(1:3, jj, ii)/qtot
3533 END DO
3534 END DO
3535
3536 colvar%ss = log(qtot)/lambda
3537 DEALLOCATE (dnoh)
3538 DEALLOCATE (noh)
3539 DEALLOCATE (m)
3540 DEALLOCATE (dm)
3541 DEALLOCATE (dnoo)
3542 DEALLOCATE (noo)
3543 DEALLOCATE (qloc)
3544
3545 END SUBROUTINE hydronium_shell_colvar
3546
3547! **************************************************************************************************
3548!> \brief evaluates the force due (and on) the hydronium_dist collective variable;
3549!> distance between hydronium and hydroxide ion
3550!> \param colvar ...
3551!> \param cell ...
3552!> \param subsys ...
3553!> \param particles ...
3554!> \author Dorothea Golze
3555! **************************************************************************************************
3556 SUBROUTINE hydronium_dist_colvar(colvar, cell, subsys, particles)
3557 TYPE(colvar_type), POINTER :: colvar
3558 TYPE(cell_type), POINTER :: cell
3559 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
3560 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
3561 POINTER :: particles
3562
3563 INTEGER :: i, ii, j, jj, k, kk, n_hydrogens, &
3564 n_oxygens, offseth, pf, pm, poh, qf, &
3565 qm, qoh
3566 REAL(dp) :: drji, drki, fscalar, invden, lambda, nh, nn, num, rion, rion_den, rion_num, &
3567 rji(3), rki(3), roh, rrel, sum_expfac_f, sum_expfac_noh
3568 REAL(dp), ALLOCATABLE, DIMENSION(:) :: dexpfac_f, dexpfac_noh, df, dm, &
3569 expfac_f, expfac_f_rki, expfac_noh, f, &
3570 m, noh
3571 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: dexpfac_f_rki
3572 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: ddist_rki, dnoh
3573 REAL(dp), DIMENSION(3) :: rpi, rpj, rpk
3574 TYPE(particle_list_type), POINTER :: particles_i
3575 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
3576
3577 n_oxygens = colvar%hydronium_dist_param%n_oxygens
3578 n_hydrogens = colvar%hydronium_dist_param%n_hydrogens
3579 poh = colvar%hydronium_dist_param%poh
3580 qoh = colvar%hydronium_dist_param%qoh
3581 roh = colvar%hydronium_dist_param%roh
3582 pm = colvar%hydronium_dist_param%pm
3583 qm = colvar%hydronium_dist_param%qm
3584 nh = colvar%hydronium_dist_param%nh
3585 pf = colvar%hydronium_dist_param%pf
3586 qf = colvar%hydronium_dist_param%qf
3587 nn = colvar%hydronium_dist_param%nn
3588 lambda = colvar%hydronium_dist_param%lambda
3589
3590 NULLIFY (particles_i)
3591 cpassert(colvar%type_id == hydronium_dist_colvar_id)
3592 IF (PRESENT(particles)) THEN
3593 my_particles => particles
3594 ELSE
3595 cpassert(PRESENT(subsys))
3596 CALL cp_subsys_get(subsys, particles=particles_i)
3597 my_particles => particles_i%els
3598 END IF
3599
3600 ALLOCATE (dnoh(3, n_hydrogens, n_oxygens))
3601 ALLOCATE (noh(n_oxygens))
3602 ALLOCATE (m(n_oxygens), dm(n_oxygens))
3603 ALLOCATE (f(n_oxygens), df(n_oxygens))
3604 ALLOCATE (expfac_noh(n_oxygens), dexpfac_noh(n_oxygens))
3605 ALLOCATE (expfac_f(n_oxygens), dexpfac_f(n_oxygens))
3606 ALLOCATE (ddist_rki(3, n_oxygens, n_oxygens))
3607 ALLOCATE (expfac_f_rki(n_oxygens))
3608 ALLOCATE (dexpfac_f_rki(n_oxygens, n_oxygens))
3609
3610 ! Zero Arrays:
3611 noh = 0._dp
3612 dnoh = 0._dp
3613 rion_num = 0._dp
3614 f = 0._dp
3615 m = 0._dp
3616 df = 0._dp
3617 dm = 0._dp
3618 expfac_noh = 0._dp
3619 expfac_f = 0._dp
3620 sum_expfac_noh = 0._dp
3621 sum_expfac_f = 0._dp
3622 ddist_rki = 0._dp
3623 expfac_f_rki = 0._dp
3624 dexpfac_f_rki = 0._dp
3625
3626 !*** Calculate coordination function noh(ii) and its derivative
3627 DO ii = 1, n_oxygens
3628 i = colvar%hydronium_dist_param%i_oxygens(ii)
3629 rpi(:) = my_particles(i)%r(1:3)
3630 DO jj = 1, n_hydrogens
3631 j = colvar%hydronium_dist_param%i_hydrogens(jj)
3632 rpj(:) = my_particles(j)%r(1:3)
3633 rji = pbc(rpj, rpi, cell)
3634 drji = sqrt(sum(rji**2))
3635 rrel = drji/roh
3636 num = (1.0_dp - rrel**poh)
3637 invden = 1.0_dp/(1.0_dp - rrel**qoh)
3638 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
3639 noh(ii) = noh(ii) + num*invden
3640 fscalar = ((-poh*(rrel**(poh - 1))*invden) &
3641 + num*(invden)**2*qoh*(rrel**(qoh - 1)))/(drji*roh)
3642 dnoh(1:3, jj, ii) = rji(1:3)*fscalar
3643 ELSE
3644 !correct limit if rji --> roh
3645 noh(ii) = noh(ii) + real(poh, dp)/real(qoh, dp)
3646 fscalar = real(poh*(poh - qoh), dp)/(real(2*qoh, dp)*roh*drji)
3647 dnoh(1:3, jj, ii) = rji(1:3)*fscalar
3648 END IF
3649 END DO
3650 END DO
3651
3652 !*** Calculate M, dM, exp(lambda*M) and sum_[exp(lambda*M)]
3653 DO ii = 1, n_oxygens
3654 num = 1.0_dp - (noh(ii)/nh)**pm
3655 invden = 1.0_dp/(1.0_dp - (noh(ii)/nh)**qm)
3656 m(ii) = 1.0_dp - num*invden
3657 dm(ii) = (pm*(noh(ii)/nh)**(pm - 1)*invden - qm*num*(invden**2)* &
3658 (noh(ii)/nh)**(qm - 1))/nh
3659 expfac_noh(ii) = exp(lambda*noh(ii))
3660 dexpfac_noh(ii) = lambda*expfac_noh(ii)
3661 sum_expfac_noh = sum_expfac_noh + expfac_noh(ii)
3662 END DO
3663
3664 !*** Calculate F, dF, exp(lambda*F) and sum_[exp(lambda*F)]
3665 DO ii = 1, n_oxygens
3666 i = colvar%hydronium_dist_param%i_oxygens(ii)
3667 num = 1.0_dp - (noh(ii)/nn)**pf
3668 invden = 1.0_dp/(1.0_dp - (noh(ii)/nn)**qf)
3669 f(ii) = num*invden
3670 df(ii) = (-pf*(noh(ii)/nn)**(pf - 1)*invden + qf*num*(invden**2)* &
3671 (noh(ii)/nn)**(qf - 1))/nn
3672 expfac_f(ii) = exp(lambda*f(ii))
3673 dexpfac_f(ii) = lambda*expfac_f(ii)
3674 sum_expfac_f = sum_expfac_f + expfac_f(ii)
3675 END DO
3676
3677 !*** Calculation numerator of rion
3678 DO ii = 1, n_oxygens
3679 i = colvar%hydronium_dist_param%i_oxygens(ii)
3680 rpi(:) = my_particles(i)%r(1:3)
3681 DO kk = 1, n_oxygens
3682 IF (ii == kk) cycle
3683 k = colvar%hydronium_dist_param%i_oxygens(kk)
3684 rpk(:) = my_particles(k)%r(1:3)
3685 rki = pbc(rpk, rpi, cell)
3686 drki = sqrt(sum(rki**2))
3687 expfac_f_rki(ii) = expfac_f_rki(ii) + drki*expfac_f(kk)
3688 ddist_rki(1:3, kk, ii) = rki(1:3)/drki
3689 dexpfac_f_rki(kk, ii) = drki*dexpfac_f(kk)
3690 END DO
3691 rion_num = rion_num + m(ii)*expfac_noh(ii)*expfac_f_rki(ii)
3692 END DO
3693
3694 !*** Final H3O+/OH- distance
3695 rion_den = sum_expfac_noh*sum_expfac_f
3696 rion = rion_num/rion_den
3697 colvar%ss = rion
3698
3699 offseth = n_oxygens
3700 !*** Derivatives numerator
3701 DO ii = 1, n_oxygens
3702 DO jj = 1, n_hydrogens
3703 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3704 + dm(ii)*dnoh(1:3, jj, ii)*expfac_noh(ii) &
3705 *expfac_f_rki(ii)/rion_den
3706 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3707 - dm(ii)*dnoh(1:3, jj, ii)*expfac_noh(ii) &
3708 *expfac_f_rki(ii)/rion_den
3709 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3710 + m(ii)*dexpfac_noh(ii)*dnoh(1:3, jj, ii) &
3711 *expfac_f_rki(ii)/rion_den
3712 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3713 - m(ii)*dexpfac_noh(ii)*dnoh(1:3, jj, ii) &
3714 *expfac_f_rki(ii)/rion_den
3715 END DO
3716 DO kk = 1, n_oxygens
3717 IF (ii == kk) cycle
3718 colvar%dsdr(1:3, kk) = colvar%dsdr(1:3, kk) &
3719 - m(ii)*expfac_noh(ii)*ddist_rki(1:3, kk, ii) &
3720 *expfac_f(kk)/rion_den
3721 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3722 + m(ii)*expfac_noh(ii)*ddist_rki(1:3, kk, ii) &
3723 *expfac_f(kk)/rion_den
3724 DO jj = 1, n_hydrogens
3725 colvar%dsdr(1:3, kk) = colvar%dsdr(1:3, kk) &
3726 + m(ii)*expfac_noh(ii)*dexpfac_f_rki(kk, ii) &
3727 *df(kk)*dnoh(1:3, jj, kk)/rion_den
3728 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3729 - m(ii)*expfac_noh(ii)*dexpfac_f_rki(kk, ii) &
3730 *df(kk)*dnoh(1:3, jj, kk)/rion_den
3731 END DO
3732 END DO
3733 END DO
3734 !*** Derivatives denominator
3735 DO ii = 1, n_oxygens
3736 DO jj = 1, n_hydrogens
3737 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3738 - rion_num*sum_expfac_f*dexpfac_noh(ii) &
3739 *dnoh(1:3, jj, ii)/(rion_den**2)
3740 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3741 + rion_num*sum_expfac_f*dexpfac_noh(ii) &
3742 *dnoh(1:3, jj, ii)/(rion_den**2)
3743 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3744 - rion_num*sum_expfac_noh*dexpfac_f(ii)*df(ii) &
3745 *dnoh(1:3, jj, ii)/(rion_den**2)
3746 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3747 + rion_num*sum_expfac_noh*dexpfac_f(ii)*df(ii) &
3748 *dnoh(1:3, jj, ii)/(rion_den**2)
3749 END DO
3750 END DO
3751
3752 DEALLOCATE (noh, m, f, expfac_noh, expfac_f)
3753 DEALLOCATE (dnoh, dm, df, dexpfac_noh, dexpfac_f)
3754 DEALLOCATE (ddist_rki, expfac_f_rki, dexpfac_f_rki)
3755
3756 END SUBROUTINE hydronium_dist_colvar
3757
3758! **************************************************************************************************
3759!> \brief evaluates the force due (and on) the acid-hydronium-distance
3760!> collective variable. Colvar: distance between carboxy group and
3761!> hydronium ion.
3762!> \param colvar collective variable
3763!> \param cell ...
3764!> \param subsys ...
3765!> \param particles ...
3766!> \author Dorothea Golze
3767!> \note this function does not use POINTS, not reasonable for this colvar
3768! **************************************************************************************************
3769 SUBROUTINE acid_hyd_dist_colvar(colvar, cell, subsys, particles)
3770 TYPE(colvar_type), POINTER :: colvar
3771 TYPE(cell_type), POINTER :: cell
3772 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
3773 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
3774 POINTER :: particles
3775
3776 INTEGER :: i, ii, j, jj, k, kk, n_hydrogens, &
3777 n_oxygens_acid, n_oxygens_water, &
3778 offseth, offseto, paoh, pcut, pwoh, &
3779 qaoh, qcut, qwoh
3780 REAL(dp), ALLOCATABLE, DIMENSION(:) :: dexpfac, expfac, nwoh
3781 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: dexpfac_rik
3782 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: ddist_rik, dnaoh, dnwoh
3783 REAL(kind=dp) :: dfcut, drik, drji, drjk, fbrace, fcut, fscalar, invden, invden_cut, lambda, &
3784 naoh, nc, num, num_cut, raoh, rik(3), rion, rion_den, rion_num, rji(3), rjk(3), rpi(3), &
3785 rpj(3), rpk(3), rrel, rwoh
3786 TYPE(particle_list_type), POINTER :: particles_i
3787 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
3788
3789 NULLIFY (my_particles, particles_i)
3790
3791 n_oxygens_water = colvar%acid_hyd_dist_param%n_oxygens_water
3792 n_oxygens_acid = colvar%acid_hyd_dist_param%n_oxygens_acid
3793 n_hydrogens = colvar%acid_hyd_dist_param%n_hydrogens
3794 pwoh = colvar%acid_hyd_dist_param%pwoh
3795 qwoh = colvar%acid_hyd_dist_param%qwoh
3796 paoh = colvar%acid_hyd_dist_param%paoh
3797 qaoh = colvar%acid_hyd_dist_param%qaoh
3798 pcut = colvar%acid_hyd_dist_param%pcut
3799 qcut = colvar%acid_hyd_dist_param%qcut
3800 rwoh = colvar%acid_hyd_dist_param%rwoh
3801 raoh = colvar%acid_hyd_dist_param%raoh
3802 nc = colvar%acid_hyd_dist_param%nc
3803 lambda = colvar%acid_hyd_dist_param%lambda
3804 ALLOCATE (expfac(n_oxygens_water))
3805 ALLOCATE (nwoh(n_oxygens_water))
3806 ALLOCATE (dnwoh(3, n_hydrogens, n_oxygens_water))
3807 ALLOCATE (dnaoh(3, n_hydrogens, n_oxygens_acid))
3808 ALLOCATE (dexpfac(n_oxygens_water))
3809 ALLOCATE (ddist_rik(3, n_oxygens_water, n_oxygens_acid))
3810 ALLOCATE (dexpfac_rik(n_oxygens_water, n_oxygens_acid))
3811 rion_den = 0._dp
3812 rion_num = 0._dp
3813 nwoh(:) = 0._dp
3814 naoh = 0._dp
3815 dnaoh(:, :, :) = 0._dp
3816 dnwoh(:, :, :) = 0._dp
3817 ddist_rik(:, :, :) = 0._dp
3818 dexpfac(:) = 0._dp
3819 dexpfac_rik(:, :) = 0._dp
3820
3821 cpassert(colvar%type_id == acid_hyd_dist_colvar_id)
3822 IF (PRESENT(particles)) THEN
3823 my_particles => particles
3824 ELSE
3825 cpassert(PRESENT(subsys))
3826 CALL cp_subsys_get(subsys, particles=particles_i)
3827 my_particles => particles_i%els
3828 END IF
3829
3830 ! Calculate coordination functions nwoh(ii) and denominator of rion
3831 DO ii = 1, n_oxygens_water
3832 i = colvar%acid_hyd_dist_param%i_oxygens_water(ii)
3833 rpi(:) = my_particles(i)%r(1:3)
3834 DO jj = 1, n_hydrogens
3835 j = colvar%acid_hyd_dist_param%i_hydrogens(jj)
3836 rpj(:) = my_particles(j)%r(1:3)
3837 rji = pbc(rpj, rpi, cell)
3838 drji = sqrt(sum(rji**2))
3839 rrel = drji/rwoh
3840 num = 1.0_dp - rrel**pwoh
3841 invden = 1.0_dp/(1.0_dp - rrel**qwoh)
3842 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
3843 nwoh(ii) = nwoh(ii) + num*invden
3844 fscalar = (-pwoh*(rrel**(pwoh - 1))*invden &
3845 + num*(invden**2)*qwoh*(rrel**(qwoh - 1)))/(drji*rwoh)
3846 dnwoh(1:3, jj, ii) = rji(1:3)*fscalar
3847 ELSE
3848 !correct limit if rji --> rwoh
3849 nwoh(ii) = nwoh(ii) + real(pwoh, dp)/real(qwoh, dp)
3850 fscalar = real(pwoh*(pwoh - qwoh), dp)/(real(2*qwoh, dp)*rwoh*drji)
3851 dnwoh(1:3, jj, ii) = rji(1:3)*fscalar
3852 END IF
3853 END DO
3854 expfac(ii) = exp(lambda*nwoh(ii))
3855 dexpfac(ii) = lambda*expfac(ii)
3856 rion_den = rion_den + expfac(ii)
3857 END DO
3858
3859 ! Calculate nominator of rion
3860 DO kk = 1, n_oxygens_acid
3861 k = colvar%acid_hyd_dist_param%i_oxygens_acid(kk)
3862 rpk(:) = my_particles(k)%r(1:3)
3863 DO ii = 1, n_oxygens_water
3864 i = colvar%acid_hyd_dist_param%i_oxygens_water(ii)
3865 rpi(:) = my_particles(i)%r(1:3)
3866 rik = pbc(rpi, rpk, cell)
3867 drik = sqrt(sum(rik**2))
3868 rion_num = rion_num + drik*expfac(ii)
3869 ddist_rik(1:3, ii, kk) = rik(1:3)/drik
3870 dexpfac_rik(ii, kk) = drik*dexpfac(ii)
3871 END DO
3872 END DO
3873
3874 !Calculate cutoff function
3875 DO kk = 1, n_oxygens_acid
3876 k = colvar%acid_hyd_dist_param%i_oxygens_acid(kk)
3877 rpk(:) = my_particles(k)%r(1:3)
3878 DO jj = 1, n_hydrogens
3879 j = colvar%acid_hyd_dist_param%i_hydrogens(jj)
3880 rpj(:) = my_particles(j)%r(1:3)
3881 rjk = pbc(rpj, rpk, cell)
3882 drjk = sqrt(sum(rjk**2))
3883 rrel = drjk/raoh
3884 num = 1.0_dp - rrel**paoh
3885 invden = 1.0_dp/(1.0_dp - rrel**qaoh)
3886 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
3887 naoh = naoh + num*invden
3888 fscalar = (-paoh*(rrel**(paoh - 1))*invden &
3889 + num*(invden**2)*qaoh*(rrel**(qaoh - 1)))/(drjk*raoh)
3890 dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar
3891 ELSE
3892 !correct limit if rjk --> raoh
3893 naoh = naoh + real(paoh, dp)/real(qaoh, dp)
3894 fscalar = real(paoh*(paoh - qaoh), dp)/(real(2*qaoh, dp)*raoh*drjk)
3895 dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar
3896 END IF
3897 END DO
3898 END DO
3899 num_cut = 1.0_dp - (naoh/nc)**pcut
3900 invden_cut = 1.0_dp/(1.0_dp - (naoh/nc)**qcut)
3901 fcut = num_cut*invden_cut
3902
3903 !Final distance acid - hydronium
3904! fbrace = rion_num/rion_den/2.0_dp
3905 fbrace = rion_num/rion_den/n_oxygens_acid
3906 rion = fcut*fbrace
3907 colvar%ss = rion
3908
3909 !Derivatives of fcut
3910 dfcut = ((-pcut*(naoh/nc)**(pcut - 1)*invden_cut) &
3911 + num_cut*(invden_cut**2)*qcut*(naoh/nc)**(qcut - 1))/nc
3912 offseto = n_oxygens_water
3913 offseth = n_oxygens_water + n_oxygens_acid
3914 DO kk = 1, n_oxygens_acid
3915 DO jj = 1, n_hydrogens
3916 colvar%dsdr(1:3, offseto + kk) = colvar%dsdr(1:3, offseto + kk) &
3917 + dfcut*dnaoh(1:3, jj, kk)*fbrace
3918 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3919 - dfcut*dnaoh(1:3, jj, kk)*fbrace
3920 END DO
3921 END DO
3922
3923 !Derivatives of fbrace
3924 !***nominator
3925 DO kk = 1, n_oxygens_acid
3926 DO ii = 1, n_oxygens_water
3927 colvar%dsdr(1:3, offseto + kk) = colvar%dsdr(1:3, offseto + kk) &
3928 + fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/n_oxygens_acid
3929! + fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/2.0_dp
3930 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3931 - fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/n_oxygens_acid
3932! - fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/2.0_dp
3933 DO jj = 1, n_hydrogens
3934 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3935 + fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/n_oxygens_acid
3936! + fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/2.0_dp
3937 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3938 - fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/n_oxygens_acid
3939! - fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/2.0_dp
3940 END DO
3941 END DO
3942 END DO
3943 !***denominator
3944 DO ii = 1, n_oxygens_water
3945 DO jj = 1, n_hydrogens
3946 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
3947 - fcut*rion_num*dexpfac(ii)*dnwoh(1:3, jj, ii)/2.0_dp/(rion_den**2)
3948 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
3949 + fcut*rion_num*dexpfac(ii)*dnwoh(1:3, jj, ii)/2.0_dp/(rion_den**2)
3950 END DO
3951 END DO
3952
3953 END SUBROUTINE acid_hyd_dist_colvar
3954
3955! **************************************************************************************************
3956!> \brief evaluates the force due (and on) the acid-hydronium-shell
3957!> collective variable. Colvar: number of oxygens in 1st shell of the
3958!> hydronium.
3959!> \param colvar collective variable
3960!> \param cell ...
3961!> \param subsys ...
3962!> \param particles ...
3963!> \author Dorothea Golze
3964!> \note this function does not use POINTS, not reasonable for this colvar
3965! **************************************************************************************************
3966 SUBROUTINE acid_hyd_shell_colvar(colvar, cell, subsys, particles)
3967 TYPE(colvar_type), POINTER :: colvar
3968 TYPE(cell_type), POINTER :: cell
3969 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
3970 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
3971 POINTER :: particles
3972
3973 INTEGER :: i, ii, j, jj, k, kk, n_hydrogens, n_oxygens_acid, n_oxygens_water, offseth, &
3974 offseto, paoh, pcut, pm, poo, pwoh, qaoh, qcut, qm, qoo, qwoh, tt
3975 REAL(dp), ALLOCATABLE, DIMENSION(:) :: dm, m, noo, nwoh, qloc
3976 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: dnaoh, dnoo, dnwoh
3977 REAL(kind=dp) :: dfcut, drji, drjk, drki, fcut, fscalar, invden, invden_cut, lambda, naoh, &
3978 nc, nh, num, num_cut, qsol, qtot, raoh, rji(3), rjk(3), rki(3), roo, rpi(3), rpj(3), &
3979 rpk(3), rrel, rwoh
3980 TYPE(particle_list_type), POINTER :: particles_i
3981 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
3982
3983 NULLIFY (my_particles, particles_i)
3984
3985 n_oxygens_water = colvar%acid_hyd_shell_param%n_oxygens_water
3986 n_oxygens_acid = colvar%acid_hyd_shell_param%n_oxygens_acid
3987 n_hydrogens = colvar%acid_hyd_shell_param%n_hydrogens
3988 pwoh = colvar%acid_hyd_shell_param%pwoh
3989 qwoh = colvar%acid_hyd_shell_param%qwoh
3990 paoh = colvar%acid_hyd_shell_param%paoh
3991 qaoh = colvar%acid_hyd_shell_param%qaoh
3992 poo = colvar%acid_hyd_shell_param%poo
3993 qoo = colvar%acid_hyd_shell_param%qoo
3994 pm = colvar%acid_hyd_shell_param%pm
3995 qm = colvar%acid_hyd_shell_param%qm
3996 pcut = colvar%acid_hyd_shell_param%pcut
3997 qcut = colvar%acid_hyd_shell_param%qcut
3998 rwoh = colvar%acid_hyd_shell_param%rwoh
3999 raoh = colvar%acid_hyd_shell_param%raoh
4000 roo = colvar%acid_hyd_shell_param%roo
4001 nc = colvar%acid_hyd_shell_param%nc
4002 nh = colvar%acid_hyd_shell_param%nh
4003 lambda = colvar%acid_hyd_shell_param%lambda
4004 ALLOCATE (nwoh(n_oxygens_water))
4005 ALLOCATE (dnwoh(3, n_hydrogens, n_oxygens_water))
4006 ALLOCATE (dnaoh(3, n_hydrogens, n_oxygens_acid))
4007 ALLOCATE (m(n_oxygens_water))
4008 ALLOCATE (dm(n_oxygens_water))
4009 ALLOCATE (noo(n_oxygens_water))
4010 ALLOCATE (dnoo(3, n_oxygens_water + n_oxygens_acid, n_oxygens_water))
4011 ALLOCATE (qloc(n_oxygens_water))
4012 nwoh(:) = 0._dp
4013 naoh = 0._dp
4014 noo = 0._dp
4015 dnaoh(:, :, :) = 0._dp
4016 dnwoh(:, :, :) = 0._dp
4017 dnoo(:, :, :) = 0._dp
4018 m = 0._dp
4019 dm = 0._dp
4020 qtot = 0._dp
4021
4022 cpassert(colvar%type_id == acid_hyd_shell_colvar_id)
4023 IF (PRESENT(particles)) THEN
4024 my_particles => particles
4025 ELSE
4026 cpassert(PRESENT(subsys))
4027 CALL cp_subsys_get(subsys, particles=particles_i)
4028 my_particles => particles_i%els
4029 END IF
4030
4031 ! Calculate coordination functions nwoh(ii) and the M function
4032 DO ii = 1, n_oxygens_water
4033 i = colvar%acid_hyd_shell_param%i_oxygens_water(ii)
4034 rpi(:) = my_particles(i)%r(1:3)
4035 DO jj = 1, n_hydrogens
4036 j = colvar%acid_hyd_shell_param%i_hydrogens(jj)
4037 rpj(:) = my_particles(j)%r(1:3)
4038 rji = pbc(rpj, rpi, cell)
4039 drji = sqrt(sum(rji**2))
4040 rrel = drji/rwoh
4041 num = 1.0_dp - rrel**pwoh
4042 invden = 1.0_dp/(1.0_dp - rrel**qwoh)
4043 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
4044 nwoh(ii) = nwoh(ii) + num*invden
4045 fscalar = (-pwoh*(rrel**(pwoh - 1))*invden &
4046 + num*(invden**2)*qwoh*(rrel**(qwoh - 1)))/(drji*rwoh)
4047 dnwoh(1:3, jj, ii) = rji(1:3)*fscalar
4048 ELSE
4049 !correct limit if rji --> rwoh
4050 nwoh(ii) = nwoh(ii) + real(pwoh, dp)/real(qwoh, dp)
4051 fscalar = real(pwoh*(pwoh - qwoh), dp)/(real(2*qwoh, dp)*rwoh*drji)
4052 dnwoh(1:3, jj, ii) = rji(1:3)*fscalar
4053 END IF
4054 END DO
4055 END DO
4056
4057 ! calculate M function
4058 DO ii = 1, n_oxygens_water
4059 num = 1.0_dp - (nwoh(ii)/nh)**pm
4060 invden = 1.0_dp/(1.0_dp - (nwoh(ii)/nh)**qm)
4061 m(ii) = 1.0_dp - num*invden
4062 dm(ii) = (pm*(nwoh(ii)/nh)**(pm - 1)*invden - qm*num*(invden**2)* &
4063 (nwoh(ii)/nh)**(qm - 1))/nh
4064 END DO
4065
4066 ! Computing noo(i)
4067 DO ii = 1, n_oxygens_water
4068 i = colvar%acid_hyd_shell_param%i_oxygens_water(ii)
4069 rpi(:) = my_particles(i)%r(1:3)
4070 DO kk = 1, n_oxygens_water + n_oxygens_acid
4071 IF (ii == kk) cycle
4072 IF (kk <= n_oxygens_water) THEN
4073 k = colvar%acid_hyd_shell_param%i_oxygens_water(kk)
4074 rpk(:) = my_particles(k)%r(1:3)
4075 ELSE
4076 tt = kk - n_oxygens_water
4077 k = colvar%acid_hyd_shell_param%i_oxygens_acid(tt)
4078 rpk(:) = my_particles(k)%r(1:3)
4079 END IF
4080 rki = pbc(rpk, rpi, cell)
4081 drki = sqrt(sum(rki**2))
4082 rrel = drki/roo
4083 num = 1.0_dp - rrel**poo
4084 invden = 1.0_dp/(1.0_dp - rrel**qoo)
4085 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
4086 noo(ii) = noo(ii) + num*invden
4087 fscalar = (-poo*(rrel**(poo - 1))*invden &
4088 + num*(invden**2)*qoo*(rrel**(qoo - 1)))/(drki*roo)
4089 dnoo(1:3, kk, ii) = rki(1:3)*fscalar
4090 ELSE
4091 !correct limit if rki --> roo
4092 noo(ii) = noo(ii) + real(poo, dp)/real(qoo, dp)
4093 fscalar = real(poo*(poo - qoo), dp)/(real(2*qoo, dp)*roo*drki)
4094 dnoo(1:3, kk, ii) = rki(1:3)*fscalar
4095 END IF
4096 END DO
4097 END DO
4098
4099 !Calculate cutoff function
4100 DO kk = 1, n_oxygens_acid
4101 k = colvar%acid_hyd_shell_param%i_oxygens_acid(kk)
4102 rpk(:) = my_particles(k)%r(1:3)
4103 DO jj = 1, n_hydrogens
4104 j = colvar%acid_hyd_shell_param%i_hydrogens(jj)
4105 rpj(:) = my_particles(j)%r(1:3)
4106 rjk = pbc(rpj, rpk, cell)
4107 drjk = sqrt(sum(rjk**2))
4108 rrel = drjk/raoh
4109 num = 1.0_dp - rrel**paoh
4110 invden = 1.0_dp/(1.0_dp - rrel**qaoh)
4111 IF (abs(1.0_dp - rrel) > 1.0e-6_dp) THEN
4112 naoh = naoh + num*invden
4113 fscalar = (-paoh*(rrel**(paoh - 1))*invden &
4114 + num*(invden**2)*qaoh*(rrel**(qaoh - 1)))/(drjk*raoh)
4115 dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar
4116 ELSE
4117 !correct limit if rjk --> raoh
4118 naoh = naoh + real(paoh, dp)/real(qaoh, dp)
4119 fscalar = real(paoh*(paoh - qaoh), dp)/(real(2*qaoh, dp)*raoh*drjk)
4120 dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar
4121 END IF
4122 END DO
4123 END DO
4124 num_cut = 1.0_dp - (naoh/nc)**pcut
4125 invden_cut = 1.0_dp/(1.0_dp - (naoh/nc)**qcut)
4126 fcut = num_cut*invden_cut
4127
4128 ! Final value: number of oxygens in 1st shell of hydronium
4129 DO ii = 1, n_oxygens_water
4130 qloc(ii) = exp(lambda*m(ii)*noo(ii))
4131 qtot = qtot + qloc(ii)
4132 END DO
4133 qsol = log(qtot)/lambda
4134 colvar%ss = fcut*qsol
4135
4136 ! Derivatives of fcut
4137 dfcut = ((-pcut*(naoh/nc)**(pcut - 1)*invden_cut) &
4138 + num_cut*(invden_cut**2)*qcut*(naoh/nc)**(qcut - 1))/nc
4139 offseto = n_oxygens_water
4140 offseth = n_oxygens_water + n_oxygens_acid
4141 DO kk = 1, n_oxygens_acid
4142 DO jj = 1, n_hydrogens
4143 colvar%dsdr(1:3, offseto + kk) = colvar%dsdr(1:3, offseto + kk) &
4144 + dfcut*dnaoh(1:3, jj, kk)*qsol
4145 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
4146 - dfcut*dnaoh(1:3, jj, kk)*qsol
4147 END DO
4148 END DO
4149
4150 ! Derivatives of qsol
4151 !*** M derivatives
4152 DO ii = 1, n_oxygens_water
4153 fscalar = fcut*qloc(ii)*dm(ii)*noo(ii)/qtot
4154 DO jj = 1, n_hydrogens
4155 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) &
4156 + fscalar*dnwoh(1:3, jj, ii)
4157 colvar%dsdr(1:3, offseth + jj) = colvar%dsdr(1:3, offseth + jj) &
4158 - fscalar*dnwoh(1:3, jj, ii)
4159 END DO
4160 END DO
4161 !*** noo derivatives
4162 DO ii = 1, n_oxygens_water
4163 fscalar = fcut*qloc(ii)*m(ii)/qtot
4164 DO kk = 1, n_oxygens_water + n_oxygens_acid
4165 IF (ii == kk) cycle
4166 colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) + fscalar*dnoo(1:3, kk, ii)
4167 colvar%dsdr(1:3, kk) = colvar%dsdr(1:3, kk) - fscalar*dnoo(1:3, kk, ii)
4168 END DO
4169 END DO
4170
4171 END SUBROUTINE acid_hyd_shell_colvar
4172
4173! **************************************************************************************************
4174!> \brief evaluates the force due (and on) the coordination-chain collective variable
4175!> \param colvar ...
4176!> \param cell ...
4177!> \param subsys ...
4178!> \param particles ...
4179!> \author MI
4180!> \note When the third set of atoms is not defined, this variable is equivalent
4181!> to the simple coordination number.
4182! **************************************************************************************************
4183 SUBROUTINE coord_colvar(colvar, cell, subsys, particles)
4184 TYPE(colvar_type), POINTER :: colvar
4185 TYPE(cell_type), POINTER :: cell
4186 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
4187 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
4188 POINTER :: particles
4189
4190 INTEGER :: i, ii, j, jj, k, kk, n_atoms_from, &
4191 n_atoms_to_a, n_atoms_to_b, p_a, p_b, &
4192 q_a, q_b
4193 REAL(dp) :: dfunc_ij, dfunc_jk, func_ij, func_jk, func_k, inv_n_atoms_from, invden_ij, &
4194 invden_jk, ncoord, num_ij, num_jk, r_0_a, r_0_b, rdist_ij, rdist_jk, rij, rjk
4195 REAL(dp), DIMENSION(3) :: ftmp_i, ftmp_j, ftmp_k, ss, xij, xjk, &
4196 xpi, xpj, xpk
4197 TYPE(particle_list_type), POINTER :: particles_i
4198 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
4199
4200! If we defined the coordination number with KINDS then we have still
4201! to fill few missing informations...
4202
4203 NULLIFY (particles_i)
4204 cpassert(colvar%type_id == coord_colvar_id)
4205 IF (PRESENT(particles)) THEN
4206 my_particles => particles
4207 ELSE
4208 cpassert(PRESENT(subsys))
4209 CALL cp_subsys_get(subsys, particles=particles_i)
4210 my_particles => particles_i%els
4211 END IF
4212 n_atoms_to_a = colvar%coord_param%n_atoms_to
4213 n_atoms_to_b = colvar%coord_param%n_atoms_to_b
4214 n_atoms_from = colvar%coord_param%n_atoms_from
4215 p_a = colvar%coord_param%nncrd
4216 q_a = colvar%coord_param%ndcrd
4217 r_0_a = colvar%coord_param%r_0
4218 p_b = colvar%coord_param%nncrd_b
4219 q_b = colvar%coord_param%ndcrd_b
4220 r_0_b = colvar%coord_param%r_0_b
4221
4222 ncoord = 0.0_dp
4223 inv_n_atoms_from = 1.0_dp/real(n_atoms_from, kind=dp)
4224 DO ii = 1, n_atoms_from
4225 i = colvar%coord_param%i_at_from(ii)
4226 CALL get_coordinates(colvar, i, xpi, my_particles)
4227 DO jj = 1, n_atoms_to_a
4228 j = colvar%coord_param%i_at_to(jj)
4229 CALL get_coordinates(colvar, j, xpj, my_particles)
4230 ! define coordination of atom A with itself to be 0. also fixes rij==0 for the force calculation
4231 IF (i == j) cycle
4232 ss = matmul(cell%h_inv, xpi(:) - xpj(:))
4233 ss = ss - nint(ss)
4234 xij = matmul(cell%hmat, ss)
4235 rij = sqrt(xij(1)**2 + xij(2)**2 + xij(3)**2)
4236 IF (rij < 1.0e-8_dp) cycle
4237 rdist_ij = rij/r_0_a
4238 IF (abs(1.0_dp - rdist_ij) > epsilon(0.0_dp)*1.0e+4_dp) THEN
4239 num_ij = (1.0_dp - rdist_ij**p_a)
4240 invden_ij = 1.0_dp/(1.0_dp - rdist_ij**q_a)
4241 func_ij = num_ij*invden_ij
4242 IF (rij < 1.0e-8_dp) THEN
4243 ! provide the correct limit of the derivative
4244 dfunc_ij = 0.0_dp
4245 ELSE
4246 dfunc_ij = (-p_a*rdist_ij**(p_a - 1)*invden_ij &
4247 + num_ij*(invden_ij)**2*q_a*rdist_ij**(q_a - 1))/(rij*r_0_a)
4248 END IF
4249 ELSE
4250 ! Provide the correct limit for function value and derivative
4251 func_ij = real(p_a, kind=dp)/real(q_a, kind=dp)
4252 dfunc_ij = real(p_a, kind=dp)*real((-q_a + p_a), kind=dp)/(real(2*q_a, kind=dp)*r_0_a)
4253 END IF
4254 IF (n_atoms_to_b /= 0) THEN
4255 func_k = 0.0_dp
4256 DO kk = 1, n_atoms_to_b
4257 k = colvar%coord_param%i_at_to_b(kk)
4258 IF (k == j) cycle
4259 CALL get_coordinates(colvar, k, xpk, my_particles)
4260 ss = matmul(cell%h_inv, xpj(:) - xpk(:))
4261 ss = ss - nint(ss)
4262 xjk = matmul(cell%hmat, ss)
4263 rjk = sqrt(xjk(1)**2 + xjk(2)**2 + xjk(3)**2)
4264 IF (rjk < 1.0e-8_dp) cycle
4265 rdist_jk = rjk/r_0_b
4266 IF (abs(1.0_dp - rdist_jk) > epsilon(0.0_dp)*1.0e+4_dp) THEN
4267 num_jk = (1.0_dp - rdist_jk**p_b)
4268 invden_jk = 1.0_dp/(1.0_dp - rdist_jk**q_b)
4269 func_jk = num_jk*invden_jk
4270 IF (rjk < 1.0e-8_dp) THEN
4271 ! provide the correct limit of the derivative
4272 dfunc_jk = 0.0_dp
4273 ELSE
4274 dfunc_jk = (-p_b*rdist_jk**(p_b - 1)*invden_jk &
4275 + num_jk*(invden_jk)**2*q_b*rdist_jk**(q_b - 1))/(rjk*r_0_b)
4276 END IF
4277 ELSE
4278 ! Provide the correct limit for function value and derivative
4279 func_jk = real(p_b, kind=dp)/real(q_b, kind=dp)
4280 dfunc_jk = real(p_b, kind=dp)*real((-q_b + p_b), kind=dp)/(real(2*q_b, kind=dp)*r_0_b)
4281 END IF
4282 func_k = func_k + func_jk
4283 ftmp_k = -func_ij*dfunc_jk*xjk
4284 CALL put_derivative(colvar, n_atoms_from + n_atoms_to_a + kk, ftmp_k)
4285
4286 ftmp_j = -dfunc_ij*xij*func_jk + func_ij*dfunc_jk*xjk
4287 CALL put_derivative(colvar, n_atoms_from + jj, ftmp_j)
4288 END DO
4289 ELSE
4290 func_k = 1.0_dp
4291 dfunc_jk = 0.0_dp
4292 ftmp_j = -dfunc_ij*xij
4293 CALL put_derivative(colvar, n_atoms_from + jj, ftmp_j)
4294 END IF
4295 ncoord = ncoord + func_ij*func_k
4296 ftmp_i = dfunc_ij*xij*func_k
4297 CALL put_derivative(colvar, ii, ftmp_i)
4298 END DO
4299 END DO
4300 colvar%ss = ncoord*inv_n_atoms_from
4301 colvar%dsdr(:, :) = colvar%dsdr(:, :)*inv_n_atoms_from
4302 END SUBROUTINE coord_colvar
4303
4304! **************************************************************************************************
4305!> \brief ...
4306!> \param colvar ...
4307!> \param cell ...
4308!> \param subsys ...
4309!> \param particles ...
4310! **************************************************************************************************
4311 SUBROUTINE mindist_colvar(colvar, cell, subsys, particles)
4312
4313 TYPE(colvar_type), POINTER :: colvar
4314 TYPE(cell_type), POINTER :: cell
4315 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
4316 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
4317 POINTER :: particles
4318
4319 INTEGER :: i, ii, j, jj, n_coord_from, n_coord_to, &
4320 n_dist_from, p, q
4321 REAL(dp) :: den_n, den_q, fscalar, ftemp_i(3), inv_den_n, inv_den_q, lambda, num_n, num_q, &
4322 qfunc, r12, r_cut, rfact, rij(3), rpi(3), rpj(3)
4323 REAL(dp), DIMENSION(:), POINTER :: dqfunc_dnl, expnl, nlcoord, sum_rij
4324 REAL(dp), DIMENSION(:, :, :), POINTER :: dnlcoord, dqfunc_dr
4325 TYPE(particle_list_type), POINTER :: particles_i
4326 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
4327
4328! If we defined the coordination number with KINDS then we have still
4329! to fill few missing informations...
4330
4331 NULLIFY (particles_i)
4332 cpassert(colvar%type_id == mindist_colvar_id)
4333 IF (PRESENT(particles)) THEN
4334 my_particles => particles
4335 ELSE
4336 cpassert(PRESENT(subsys))
4337 CALL cp_subsys_get(subsys, particles=particles_i)
4338 my_particles => particles_i%els
4339 END IF
4340
4341 n_dist_from = colvar%mindist_param%n_dist_from
4342 n_coord_from = colvar%mindist_param%n_coord_from
4343 n_coord_to = colvar%mindist_param%n_coord_to
4344 p = colvar%mindist_param%p_exp
4345 q = colvar%mindist_param%q_exp
4346 r_cut = colvar%mindist_param%r_cut
4347 lambda = colvar%mindist_param%lambda
4348
4349 NULLIFY (nlcoord, dnlcoord, dqfunc_dr, dqfunc_dnl, expnl, sum_rij)
4350 ALLOCATE (nlcoord(n_coord_from))
4351 ALLOCATE (dnlcoord(3, n_coord_from, n_coord_to))
4352 ALLOCATE (expnl(n_coord_from))
4353 ALLOCATE (sum_rij(n_coord_from))
4354 ALLOCATE (dqfunc_dr(3, n_dist_from, n_coord_from))
4355 ALLOCATE (dqfunc_dnl(n_coord_from))
4356
4357 ! coordination numbers
4358 nlcoord = 0.0_dp
4359 dnlcoord = 0.0_dp
4360 expnl = 0.0_dp
4361 den_q = 0.0_dp
4362 DO i = 1, n_coord_from
4363 ii = colvar%mindist_param%i_coord_from(i)
4364 rpi = my_particles(ii)%r(1:3)
4365 DO j = 1, n_coord_to
4366 jj = colvar%mindist_param%i_coord_to(j)
4367 rpj = my_particles(jj)%r(1:3)
4368 rij = pbc(rpj, rpi, cell)
4369 r12 = sqrt(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3))
4370 rfact = r12/r_cut
4371 num_n = 1.0_dp - rfact**p
4372 den_n = 1.0_dp - rfact**q
4373 inv_den_n = 1.0_dp/den_n
4374 IF (abs(inv_den_n) < 1.e-10_dp) THEN
4375 inv_den_n = 1.e-10_dp
4376 num_n = abs(num_n)
4377 END IF
4378
4379 fscalar = (-p*rfact**(p - 1) + num_n*q*rfact**(q - 1)*inv_den_n)*inv_den_n/(r_cut*r12)
4380
4381 dnlcoord(1, i, j) = rij(1)*fscalar
4382 dnlcoord(2, i, j) = rij(2)*fscalar
4383 dnlcoord(3, i, j) = rij(3)*fscalar
4384
4385 nlcoord(i) = nlcoord(i) + num_n*inv_den_n
4386 END DO
4387 expnl(i) = exp(lambda*nlcoord(i))
4388 den_q = den_q + expnl(i)
4389 END DO
4390 inv_den_q = 1.0_dp/den_q
4391
4392 qfunc = 0.0_dp
4393 dqfunc_dr = 0.0_dp
4394 dqfunc_dnl = 0.0_dp
4395 num_q = 0.0_dp
4396 sum_rij = 0.0_dp
4397 DO i = 1, n_dist_from
4398 ii = colvar%mindist_param%i_dist_from(i)
4399 rpi = my_particles(ii)%r(1:3)
4400 DO j = 1, n_coord_from
4401 jj = colvar%mindist_param%i_coord_from(j)
4402 rpj = my_particles(jj)%r(1:3)
4403 rij = pbc(rpj, rpi, cell)
4404 r12 = sqrt(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3))
4405
4406 num_q = num_q + r12*expnl(j)
4407
4408 sum_rij(j) = sum_rij(j) + r12
4409 dqfunc_dr(1, i, j) = expnl(j)*rij(1)/r12
4410 dqfunc_dr(2, i, j) = expnl(j)*rij(2)/r12
4411 dqfunc_dr(3, i, j) = expnl(j)*rij(3)/r12
4412
4413 END DO
4414
4415 END DO
4416
4417 ! Function and derivatives
4418 qfunc = num_q*inv_den_q
4419 dqfunc_dr = dqfunc_dr*inv_den_q
4420 colvar%ss = qfunc
4421
4422 DO i = 1, n_coord_from
4423 dqfunc_dnl(i) = lambda*expnl(i)*inv_den_q*(sum_rij(i) - num_q*inv_den_q)
4424 END DO
4425
4426 !Compute Forces
4427 DO i = 1, n_dist_from
4428 DO j = 1, n_coord_from
4429 ftemp_i(1) = dqfunc_dr(1, i, j)
4430 ftemp_i(2) = dqfunc_dr(2, i, j)
4431 ftemp_i(3) = dqfunc_dr(3, i, j)
4432
4433 CALL put_derivative(colvar, i, ftemp_i)
4434 CALL put_derivative(colvar, j + n_dist_from, -ftemp_i)
4435
4436 END DO
4437 END DO
4438 DO i = 1, n_coord_from
4439 DO j = 1, n_coord_to
4440 ftemp_i(1) = dqfunc_dnl(i)*dnlcoord(1, i, j)
4441 ftemp_i(2) = dqfunc_dnl(i)*dnlcoord(2, i, j)
4442 ftemp_i(3) = dqfunc_dnl(i)*dnlcoord(3, i, j)
4443
4444 CALL put_derivative(colvar, i + n_dist_from, ftemp_i)
4445 CALL put_derivative(colvar, j + n_dist_from + n_coord_from, -ftemp_i)
4446
4447 END DO
4448 END DO
4449
4450 DEALLOCATE (nlcoord)
4451 DEALLOCATE (dnlcoord)
4452 DEALLOCATE (expnl)
4453 DEALLOCATE (dqfunc_dr)
4454 DEALLOCATE (sum_rij)
4455 DEALLOCATE (dqfunc_dnl)
4456
4457 END SUBROUTINE mindist_colvar
4458
4459! **************************************************************************************************
4460!> \brief evaluates function and forces due to a combination of COLVARs
4461!> \param colvar ...
4462!> \param cell ...
4463!> \param subsys ...
4464!> \param particles ...
4465!> \author Teodoro Laino [tlaino] - 12.2008
4466! **************************************************************************************************
4467 SUBROUTINE combine_colvar(colvar, cell, subsys, particles)
4468 TYPE(colvar_type), POINTER :: colvar
4469 TYPE(cell_type), POINTER :: cell
4470 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
4471 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
4472 POINTER :: particles
4473
4474 CHARACTER(LEN=default_string_length) :: def_error, this_error
4475 CHARACTER(LEN=default_string_length), &
4476 ALLOCATABLE, DIMENSION(:) :: my_par
4477 INTEGER :: i, ii, j, ncolv, ndim
4478 REAL(dp) :: err
4479 REAL(dp), ALLOCATABLE, DIMENSION(:) :: dss_vals, my_val, ss_vals
4480 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: fi
4481 TYPE(particle_list_type), POINTER :: particles_i
4482 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
4483
4484 cpassert(colvar%type_id == combine_colvar_id)
4485 IF (PRESENT(particles)) THEN
4486 my_particles => particles
4487 ELSE
4488 cpassert(PRESENT(subsys))
4489 CALL cp_subsys_get(subsys, particles=particles_i)
4490 my_particles => particles_i%els
4491 END IF
4492
4493 ncolv = SIZE(colvar%combine_cvs_param%colvar_p)
4494 ALLOCATE (ss_vals(ncolv))
4495 ALLOCATE (dss_vals(ncolv))
4496
4497 ! Evaluate the individual COLVARs
4498 DO i = 1, ncolv
4499 CALL colvar_recursive_eval(colvar%combine_cvs_param%colvar_p(i)%colvar, cell, my_particles)
4500 ss_vals(i) = colvar%combine_cvs_param%colvar_p(i)%colvar%ss
4501 END DO
4502
4503 ! Evaluate the combination of the COLVARs
4504 CALL initf(1)
4505 ndim = SIZE(colvar%combine_cvs_param%c_parameters) + &
4506 SIZE(colvar%combine_cvs_param%variables)
4507 ALLOCATE (my_par(ndim))
4508 my_par(1:SIZE(colvar%combine_cvs_param%variables)) = colvar%combine_cvs_param%variables
4509 my_par(SIZE(colvar%combine_cvs_param%variables) + 1:) = colvar%combine_cvs_param%c_parameters
4510 ALLOCATE (my_val(ndim))
4511 my_val(1:SIZE(colvar%combine_cvs_param%variables)) = ss_vals
4512 my_val(SIZE(colvar%combine_cvs_param%variables) + 1:) = colvar%combine_cvs_param%v_parameters
4513 CALL parsef(1, trim(colvar%combine_cvs_param%function), my_par)
4514 colvar%ss = evalf(1, my_val)
4515 DO i = 1, ncolv
4516 dss_vals(i) = evalfd(1, i, my_val, colvar%combine_cvs_param%dx, err)
4517 IF ((abs(err) > colvar%combine_cvs_param%lerr)) THEN
4518 WRITE (this_error, "(A,G12.6,A)") "(", err, ")"
4519 WRITE (def_error, "(A,G12.6,A)") "(", colvar%combine_cvs_param%lerr, ")"
4520 CALL compress(this_error, .true.)
4521 CALL compress(def_error, .true.)
4522 CALL cp_warn(__location__, &
4523 'ASSERTION (cond) failed at line '//cp_to_string(__line__)// &
4524 ' Error '//trim(this_error)//' in computing numerical derivatives larger then'// &
4525 trim(def_error)//' . ')
4526 END IF
4527 END DO
4528 DEALLOCATE (my_val)
4529 DEALLOCATE (my_par)
4530 CALL finalizef()
4531
4532 ! Evaluate forces
4533 ALLOCATE (fi(3, colvar%n_atom_s))
4534 ii = 0
4535 DO i = 1, ncolv
4536 DO j = 1, colvar%combine_cvs_param%colvar_p(i)%colvar%n_atom_s
4537 ii = ii + 1
4538 fi(:, ii) = colvar%combine_cvs_param%colvar_p(i)%colvar%dsdr(:, j)*dss_vals(i)
4539 END DO
4540 END DO
4541
4542 DO i = 1, colvar%n_atom_s
4543 CALL put_derivative(colvar, i, fi(:, i))
4544 END DO
4545
4546 DEALLOCATE (fi)
4547 DEALLOCATE (ss_vals)
4548 DEALLOCATE (dss_vals)
4549 END SUBROUTINE combine_colvar
4550
4551! **************************************************************************************************
4552!> \brief evaluates the force due (and on) reaction path collective variable
4553!> ss(R) = [\sum_i i*dt exp{-\lambda \sum_a(S_a(R)-f_a(i))^2}]/
4554!> [\sum_i exp{-\lambda \sum_a(S_a(R)-f_a(i))^2}]
4555!> \param colvar ...
4556!> \param cell ...
4557!> \param subsys ...
4558!> \param particles ...
4559!> \par History
4560!> extended MI 01.2010
4561!> \author fschiff
4562!> \note the system is still able to move in the space spanned by the CV
4563!> perpendicular to the path
4564! **************************************************************************************************
4565 SUBROUTINE reaction_path_colvar(colvar, cell, subsys, particles)
4566 TYPE(colvar_type), POINTER :: colvar
4567 TYPE(cell_type), POINTER :: cell
4568 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
4569 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
4570 POINTER :: particles
4571
4572 TYPE(particle_list_type), POINTER :: particles_i
4573 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
4574
4575 cpassert(colvar%type_id == reaction_path_colvar_id)
4576 IF (PRESENT(particles)) THEN
4577 my_particles => particles
4578 ELSE
4579 cpassert(PRESENT(subsys))
4580 CALL cp_subsys_get(subsys, particles=particles_i)
4581 my_particles => particles_i%els
4582 END IF
4583
4584 IF (colvar%reaction_path_param%dist_rmsd) THEN
4585 CALL rpath_dist_rmsd(colvar, my_particles)
4586 ELSE IF (colvar%reaction_path_param%rmsd) THEN
4587 CALL rpath_rmsd(colvar, my_particles)
4588 ELSE
4589 CALL rpath_colvar(colvar, cell, my_particles)
4590 END IF
4591
4592 END SUBROUTINE reaction_path_colvar
4593
4594! **************************************************************************************************
4595!> \brief position along the path calculated using selected colvars
4596!> as compared to functions describing the variation of these same colvars
4597!> along the path given as reference
4598!> \param colvar ...
4599!> \param cell ...
4600!> \param particles ...
4601!> \author fschiff
4602! **************************************************************************************************
4603 SUBROUTINE rpath_colvar(colvar, cell, particles)
4604 TYPE(colvar_type), POINTER :: colvar
4605 TYPE(cell_type), POINTER :: cell
4606 TYPE(particle_type), DIMENSION(:), POINTER :: particles
4607
4608 INTEGER :: i, iend, ii, istart, j, k, ncolv, nconf
4609 REAL(dp) :: lambda, step_size
4610 REAL(dp), ALLOCATABLE, DIMENSION(:) :: s1, ss_vals
4611 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: ds1, f_vals, fi, s1v
4612 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: ds1v
4613
4614 istart = colvar%reaction_path_param%function_bounds(1)
4615 iend = colvar%reaction_path_param%function_bounds(2)
4616
4617 nconf = colvar%reaction_path_param%nr_frames
4618 step_size = colvar%reaction_path_param%step_size
4619 ncolv = colvar%reaction_path_param%n_components
4620 lambda = colvar%reaction_path_param%lambda
4621 ALLOCATE (f_vals(ncolv, istart:iend))
4622 f_vals(:, :) = colvar%reaction_path_param%f_vals
4623 ALLOCATE (ss_vals(ncolv))
4624
4625 DO i = 1, ncolv
4626 CALL colvar_recursive_eval(colvar%reaction_path_param%colvar_p(i)%colvar, cell, particles)
4627 ss_vals(i) = colvar%reaction_path_param%colvar_p(i)%colvar%ss
4628 END DO
4629
4630 ALLOCATE (s1v(2, istart:iend))
4631 ALLOCATE (ds1v(ncolv, 2, istart:iend))
4632
4633 ALLOCATE (s1(2))
4634 ALLOCATE (ds1(ncolv, 2))
4635
4636 DO k = istart, iend
4637 s1v(1, k) = real(k, kind=dp)*step_size*exp(-lambda*dot_product(ss_vals(:) - f_vals(:, k), ss_vals(:) - f_vals(:, k)))
4638 s1v(2, k) = exp(-lambda*dot_product(ss_vals(:) - f_vals(:, k), ss_vals(:) - f_vals(:, k)))
4639 DO j = 1, ncolv
4640 ds1v(j, 1, k) = f_vals(j, k)*s1v(1, k)
4641 ds1v(j, 2, k) = f_vals(j, k)*s1v(2, k)
4642 END DO
4643 END DO
4644 DO i = 1, 2
4645 s1(i) = accurate_sum(s1v(i, :))
4646 DO j = 1, ncolv
4647 ds1(j, i) = accurate_sum(ds1v(j, i, :))
4648 END DO
4649 END DO
4650
4651 colvar%ss = s1(1)/s1(2)/real(nconf - 1, dp)
4652
4653 ALLOCATE (fi(3, colvar%n_atom_s))
4654
4655 ii = 0
4656 DO i = 1, ncolv
4657 DO j = 1, colvar%reaction_path_param%colvar_p(i)%colvar%n_atom_s
4658 ii = ii + 1
4659 fi(:, ii) = colvar%reaction_path_param%colvar_p(i)%colvar%dsdr(:, j)*lambda* &
4660 (ds1(i, 1)/s1(2)/real(nconf - 1, dp) - colvar%ss*ds1(i, 2)/s1(2))*2.0_dp
4661 END DO
4662 END DO
4663
4664 DO i = 1, colvar%n_atom_s
4665 CALL put_derivative(colvar, i, fi(:, i))
4666 END DO
4667
4668 DEALLOCATE (fi)
4669 DEALLOCATE (f_vals)
4670 DEALLOCATE (ss_vals)
4671 DEALLOCATE (s1v)
4672 DEALLOCATE (ds1v)
4673 DEALLOCATE (s1)
4674 DEALLOCATE (ds1)
4675
4676 END SUBROUTINE rpath_colvar
4677
4678! **************************************************************************************************
4679!> \brief position along the path calculated from the positions of a selected list of
4680!> atoms as compared to the same positions in reference
4681!> configurations belonging to the given path.
4682!> \param colvar ...
4683!> \param particles ...
4684!> \date 01.2010
4685!> \author MI
4686! **************************************************************************************************
4687 SUBROUTINE rpath_dist_rmsd(colvar, particles)
4688 TYPE(colvar_type), POINTER :: colvar
4689 TYPE(particle_type), DIMENSION(:), POINTER :: particles
4690
4691 INTEGER :: i, iat, ii, ik, natom, nconf, rmsd_atom
4692 INTEGER, DIMENSION(:), POINTER :: iatom
4693 REAL(dp) :: lambda, my_rmsd, s1(2), sum_exp
4694 REAL(dp), ALLOCATABLE, DIMENSION(:) :: r, r0, vec_dif
4695 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: dvec_dif, fi, riat, s1v
4696 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: ds1
4697 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: ds1v
4698 REAL(dp), DIMENSION(:, :), POINTER :: path_conf
4699
4700 nconf = colvar%reaction_path_param%nr_frames
4701 rmsd_atom = colvar%reaction_path_param%n_components
4702 lambda = colvar%reaction_path_param%lambda
4703 path_conf => colvar%reaction_path_param%r_ref
4704 iatom => colvar%reaction_path_param%i_rmsd
4705
4706 natom = SIZE(particles)
4707
4708 ALLOCATE (r0(3*natom))
4709 ALLOCATE (r(3*natom))
4710 ALLOCATE (riat(3, rmsd_atom))
4711 ALLOCATE (vec_dif(rmsd_atom))
4712 ALLOCATE (dvec_dif(3, rmsd_atom))
4713 ALLOCATE (s1v(2, nconf))
4714 ALLOCATE (ds1v(3, rmsd_atom, 2, nconf))
4715 ALLOCATE (ds1(3, rmsd_atom, 2))
4716 DO i = 1, natom
4717 ii = (i - 1)*3
4718 r0(ii + 1) = particles(i)%r(1)
4719 r0(ii + 2) = particles(i)%r(2)
4720 r0(ii + 3) = particles(i)%r(3)
4721 END DO
4722
4723 DO iat = 1, rmsd_atom
4724 ii = iatom(iat)
4725 riat(:, iat) = particles(ii)%r
4726 END DO
4727
4728 DO ik = 1, nconf
4729 DO i = 1, natom
4730 ii = (i - 1)*3
4731 r(ii + 1) = path_conf(ii + 1, ik)
4732 r(ii + 2) = path_conf(ii + 2, ik)
4733 r(ii + 3) = path_conf(ii + 3, ik)
4734 END DO
4735
4736 CALL rmsd3(particles, r, r0, output_unit=-1, my_val=my_rmsd, rotate=.true.)
4737
4738 sum_exp = 0.0_dp
4739 DO iat = 1, rmsd_atom
4740 i = iatom(iat)
4741 ii = (i - 1)*3
4742 vec_dif(iat) = (riat(1, iat) - r(ii + 1))**2 + (riat(2, iat) - r(ii + 2))**2 &
4743 + (riat(3, iat) - r(ii + 3))**2
4744 sum_exp = sum_exp + vec_dif(iat)
4745 END DO
4746
4747 s1v(1, ik) = real(ik - 1, dp)*exp(-lambda*sum_exp)
4748 s1v(2, ik) = exp(-lambda*sum_exp)
4749 DO iat = 1, rmsd_atom
4750 i = iatom(iat)
4751 ii = (i - 1)*3
4752 ds1v(1, iat, 1, ik) = r(ii + 1)*s1v(1, ik)
4753 ds1v(1, iat, 2, ik) = r(ii + 1)*s1v(2, ik)
4754 ds1v(2, iat, 1, ik) = r(ii + 2)*s1v(1, ik)
4755 ds1v(2, iat, 2, ik) = r(ii + 2)*s1v(2, ik)
4756 ds1v(3, iat, 1, ik) = r(ii + 3)*s1v(1, ik)
4757 ds1v(3, iat, 2, ik) = r(ii + 3)*s1v(2, ik)
4758 END DO
4759
4760 END DO
4761 s1(1) = accurate_sum(s1v(1, :))
4762 s1(2) = accurate_sum(s1v(2, :))
4763 DO i = 1, 2
4764 DO iat = 1, rmsd_atom
4765 ds1(1, iat, i) = accurate_sum(ds1v(1, iat, i, :))
4766 ds1(2, iat, i) = accurate_sum(ds1v(2, iat, i, :))
4767 ds1(3, iat, i) = accurate_sum(ds1v(3, iat, i, :))
4768 END DO
4769 END DO
4770
4771 colvar%ss = s1(1)/s1(2)/real(nconf - 1, dp)
4772
4773 ALLOCATE (fi(3, rmsd_atom))
4774
4775 DO iat = 1, rmsd_atom
4776 fi(1, iat) = 2.0_dp*lambda/s1(2)/real(nconf - 1, dp)*(ds1(1, iat, 1) - ds1(1, iat, 2)*s1(1)/s1(2))
4777 fi(2, iat) = 2.0_dp*lambda/s1(2)/real(nconf - 1, dp)*(ds1(2, iat, 1) - ds1(2, iat, 2)*s1(1)/s1(2))
4778 fi(3, iat) = 2.0_dp*lambda/s1(2)/real(nconf - 1, dp)*(ds1(3, iat, 1) - ds1(3, iat, 2)*s1(1)/s1(2))
4779 CALL put_derivative(colvar, iat, fi(:, iat))
4780 END DO
4781
4782 DEALLOCATE (fi)
4783 DEALLOCATE (r0)
4784 DEALLOCATE (r)
4785 DEALLOCATE (riat)
4786 DEALLOCATE (vec_dif)
4787 DEALLOCATE (dvec_dif)
4788 DEALLOCATE (s1v)
4789 DEALLOCATE (ds1v)
4790 DEALLOCATE (ds1)
4791
4792 END SUBROUTINE rpath_dist_rmsd
4793
4794! **************************************************************************************************
4795!> \brief ...
4796!> \param colvar ...
4797!> \param particles ...
4798! **************************************************************************************************
4799 SUBROUTINE rpath_rmsd(colvar, particles)
4800 TYPE(colvar_type), POINTER :: colvar
4801 TYPE(particle_type), DIMENSION(:), POINTER :: particles
4802
4803 INTEGER :: i, iat, ii, ik, natom, nconf, rmsd_atom
4804 INTEGER, DIMENSION(:), POINTER :: iatom
4805 REAL(dp) :: lambda, my_rmsd, s1(2)
4806 REAL(dp), ALLOCATABLE, DIMENSION(:) :: r, r0
4807 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: fi, riat, s1v
4808 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: ds1
4809 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: ds1v
4810 REAL(dp), DIMENSION(:, :), POINTER :: path_conf
4811 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: weight
4812 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: drmsd
4813
4814 nconf = colvar%reaction_path_param%nr_frames
4815 rmsd_atom = colvar%reaction_path_param%n_components
4816 lambda = colvar%reaction_path_param%lambda
4817 path_conf => colvar%reaction_path_param%r_ref
4818 iatom => colvar%reaction_path_param%i_rmsd
4819
4820 natom = SIZE(particles)
4821
4822 ALLOCATE (r0(3*natom))
4823 ALLOCATE (r(3*natom))
4824 ALLOCATE (riat(3, rmsd_atom))
4825 ALLOCATE (s1v(2, nconf))
4826 ALLOCATE (ds1v(3, rmsd_atom, 2, nconf))
4827 ALLOCATE (ds1(3, rmsd_atom, 2))
4828 ALLOCATE (drmsd(3, natom))
4829 drmsd = 0.0_dp
4830 ALLOCATE (weight(natom))
4831
4832 DO i = 1, natom
4833 ii = (i - 1)*3
4834 r0(ii + 1) = particles(i)%r(1)
4835 r0(ii + 2) = particles(i)%r(2)
4836 r0(ii + 3) = particles(i)%r(3)
4837 END DO
4838
4839 DO iat = 1, rmsd_atom
4840 ii = iatom(iat)
4841 riat(:, iat) = particles(ii)%r
4842 END DO
4843
4844! set weights of atoms in the rmsd list
4845 weight = 0.0_dp
4846 DO iat = 1, rmsd_atom
4847 i = iatom(iat)
4848 weight(i) = 1.0_dp
4849 END DO
4850
4851 DO ik = 1, nconf
4852 DO i = 1, natom
4853 ii = (i - 1)*3
4854 r(ii + 1) = path_conf(ii + 1, ik)
4855 r(ii + 2) = path_conf(ii + 2, ik)
4856 r(ii + 3) = path_conf(ii + 3, ik)
4857 END DO
4858
4859 CALL rmsd3(particles, r0, r, output_unit=-1, weights=weight, my_val=my_rmsd, &
4860 rotate=.false., drmsd3=drmsd)
4861
4862 s1v(1, ik) = real(ik - 1, dp)*exp(-lambda*my_rmsd)
4863 s1v(2, ik) = exp(-lambda*my_rmsd)
4864 DO iat = 1, rmsd_atom
4865 i = iatom(iat)
4866 ds1v(1, iat, 1, ik) = drmsd(1, i)*s1v(1, ik)
4867 ds1v(1, iat, 2, ik) = drmsd(1, i)*s1v(2, ik)
4868 ds1v(2, iat, 1, ik) = drmsd(2, i)*s1v(1, ik)
4869 ds1v(2, iat, 2, ik) = drmsd(2, i)*s1v(2, ik)
4870 ds1v(3, iat, 1, ik) = drmsd(3, i)*s1v(1, ik)
4871 ds1v(3, iat, 2, ik) = drmsd(3, i)*s1v(2, ik)
4872 END DO
4873 END DO ! ik
4874
4875 s1(1) = accurate_sum(s1v(1, :))
4876 s1(2) = accurate_sum(s1v(2, :))
4877 DO i = 1, 2
4878 DO iat = 1, rmsd_atom
4879 ds1(1, iat, i) = accurate_sum(ds1v(1, iat, i, :))
4880 ds1(2, iat, i) = accurate_sum(ds1v(2, iat, i, :))
4881 ds1(3, iat, i) = accurate_sum(ds1v(3, iat, i, :))
4882 END DO
4883 END DO
4884
4885 colvar%ss = s1(1)/s1(2)/real(nconf - 1, dp)
4886
4887 ALLOCATE (fi(3, rmsd_atom))
4888
4889 DO iat = 1, rmsd_atom
4890 fi(1, iat) = -lambda/s1(2)/real(nconf - 1, dp)*(ds1(1, iat, 1) - ds1(1, iat, 2)*s1(1)/s1(2))
4891 fi(2, iat) = -lambda/s1(2)/real(nconf - 1, dp)*(ds1(2, iat, 1) - ds1(2, iat, 2)*s1(1)/s1(2))
4892 fi(3, iat) = -lambda/s1(2)/real(nconf - 1, dp)*(ds1(3, iat, 1) - ds1(3, iat, 2)*s1(1)/s1(2))
4893 CALL put_derivative(colvar, iat, fi(:, iat))
4894 END DO
4895
4896 DEALLOCATE (fi)
4897 DEALLOCATE (r0)
4898 DEALLOCATE (r)
4899 DEALLOCATE (riat)
4900 DEALLOCATE (s1v)
4901 DEALLOCATE (ds1v)
4902 DEALLOCATE (ds1)
4903 DEALLOCATE (drmsd)
4904 DEALLOCATE (weight)
4905
4906 END SUBROUTINE rpath_rmsd
4907
4908! **************************************************************************************************
4909!> \brief evaluates the force due (and on) distance from reaction path collective variable
4910!> ss(R) = -1/\lambda \log[\sum_i exp{-\lambda \sum_a(S_a(R)-f_a(i))^2}]
4911!> \param colvar ...
4912!> \param cell ...
4913!> \param subsys ...
4914!> \param particles ...
4915!> \date 01.2010
4916!> \author MI
4917! **************************************************************************************************
4918 SUBROUTINE distance_from_path_colvar(colvar, cell, subsys, particles)
4919 TYPE(colvar_type), POINTER :: colvar
4920 TYPE(cell_type), POINTER :: cell
4921 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
4922 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
4923 POINTER :: particles
4924
4925 TYPE(particle_list_type), POINTER :: particles_i
4926 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
4927
4928 cpassert(colvar%type_id == distance_from_path_colvar_id)
4929 IF (PRESENT(particles)) THEN
4930 my_particles => particles
4931 ELSE
4932 cpassert(PRESENT(subsys))
4933 CALL cp_subsys_get(subsys, particles=particles_i)
4934 my_particles => particles_i%els
4935 END IF
4936
4937 IF (colvar%reaction_path_param%dist_rmsd) THEN
4938 CALL dpath_dist_rmsd(colvar, my_particles)
4939 ELSE IF (colvar%reaction_path_param%rmsd) THEN
4940 CALL dpath_rmsd(colvar, my_particles)
4941 ELSE
4942 CALL dpath_colvar(colvar, cell, my_particles)
4943 END IF
4944
4945 END SUBROUTINE distance_from_path_colvar
4946
4947! **************************************************************************************************
4948!> \brief distance from path calculated using selected colvars
4949!> as compared to functions describing the variation of these same colvars
4950!> along the path given as reference
4951!> \param colvar ...
4952!> \param cell ...
4953!> \param particles ...
4954!> \date 01.2010
4955!> \author MI
4956! **************************************************************************************************
4957 SUBROUTINE dpath_colvar(colvar, cell, particles)
4958 TYPE(colvar_type), POINTER :: colvar
4959 TYPE(cell_type), POINTER :: cell
4960 TYPE(particle_type), DIMENSION(:), POINTER :: particles
4961
4962 INTEGER :: i, iend, ii, istart, j, k, ncolv
4963 REAL(dp) :: lambda, s1
4964 REAL(dp), ALLOCATABLE, DIMENSION(:) :: ds1, s1v, ss_vals
4965 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: ds1v, f_vals, fi
4966
4967 istart = colvar%reaction_path_param%function_bounds(1)
4968 iend = colvar%reaction_path_param%function_bounds(2)
4969
4970 ncolv = colvar%reaction_path_param%n_components
4971 lambda = colvar%reaction_path_param%lambda
4972 ALLOCATE (f_vals(ncolv, istart:iend))
4973 f_vals(:, :) = colvar%reaction_path_param%f_vals
4974 ALLOCATE (ss_vals(ncolv))
4975
4976 DO i = 1, ncolv
4977 CALL colvar_recursive_eval(colvar%reaction_path_param%colvar_p(i)%colvar, cell, particles)
4978 ss_vals(i) = colvar%reaction_path_param%colvar_p(i)%colvar%ss
4979 END DO
4980
4981 ALLOCATE (s1v(istart:iend))
4982 ALLOCATE (ds1v(ncolv, istart:iend))
4983 ALLOCATE (ds1(ncolv))
4984
4985 DO k = istart, iend
4986 s1v(k) = exp(-lambda*dot_product(ss_vals(:) - f_vals(:, k), ss_vals(:) - f_vals(:, k)))
4987 DO j = 1, ncolv
4988 ds1v(j, k) = f_vals(j, k)*s1v(k)
4989 END DO
4990 END DO
4991
4992 s1 = accurate_sum(s1v(:))
4993 DO j = 1, ncolv
4994 ds1(j) = accurate_sum(ds1v(j, :))
4995 END DO
4996 colvar%ss = -1.0_dp/lambda*log(s1)
4997
4998 ALLOCATE (fi(3, colvar%n_atom_s))
4999
5000 ii = 0
5001 DO i = 1, ncolv
5002 DO j = 1, colvar%reaction_path_param%colvar_p(i)%colvar%n_atom_s
5003 ii = ii + 1
5004 fi(:, ii) = colvar%reaction_path_param%colvar_p(i)%colvar%dsdr(:, j)* &
5005 2.0_dp*(ss_vals(i) - ds1(i)/s1)
5006 END DO
5007 END DO
5008
5009 DO i = 1, colvar%n_atom_s
5010 CALL put_derivative(colvar, i, fi(:, i))
5011 END DO
5012
5013 DEALLOCATE (fi)
5014 DEALLOCATE (f_vals)
5015 DEALLOCATE (ss_vals)
5016 DEALLOCATE (s1v)
5017 DEALLOCATE (ds1v)
5018 DEALLOCATE (ds1)
5019
5020 END SUBROUTINE dpath_colvar
5021
5022! **************************************************************************************************
5023!> \brief distance from path calculated from the positions of a selected list of
5024!> atoms as compared to the same positions in reference
5025!> configurations belonging to the given path.
5026!> \param colvar ...
5027!> \param particles ...
5028!> \date 01.2010
5029!> \author MI
5030! **************************************************************************************************
5031 SUBROUTINE dpath_dist_rmsd(colvar, particles)
5032
5033 TYPE(colvar_type), POINTER :: colvar
5034 TYPE(particle_type), DIMENSION(:), POINTER :: particles
5035
5036 INTEGER :: i, iat, ii, ik, natom, nconf, rmsd_atom
5037 INTEGER, DIMENSION(:), POINTER :: iatom
5038 REAL(dp) :: lambda, s1, sum_exp
5039 REAL(dp), ALLOCATABLE, DIMENSION(:) :: r, r0, s1v, vec_dif
5040 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: ds1, dvec_dif, fi, riat
5041 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: ds1v
5042 REAL(dp), DIMENSION(:, :), POINTER :: path_conf
5043
5044 nconf = colvar%reaction_path_param%nr_frames
5045 rmsd_atom = colvar%reaction_path_param%n_components
5046 lambda = colvar%reaction_path_param%lambda
5047 path_conf => colvar%reaction_path_param%r_ref
5048 iatom => colvar%reaction_path_param%i_rmsd
5049
5050 natom = SIZE(particles)
5051
5052 ALLOCATE (r0(3*natom))
5053 ALLOCATE (r(3*natom))
5054 ALLOCATE (riat(3, rmsd_atom))
5055 ALLOCATE (vec_dif(rmsd_atom))
5056 ALLOCATE (dvec_dif(3, rmsd_atom))
5057 ALLOCATE (s1v(nconf))
5058 ALLOCATE (ds1v(3, rmsd_atom, nconf))
5059 ALLOCATE (ds1(3, rmsd_atom))
5060 DO i = 1, natom
5061 ii = (i - 1)*3
5062 r0(ii + 1) = particles(i)%r(1)
5063 r0(ii + 2) = particles(i)%r(2)
5064 r0(ii + 3) = particles(i)%r(3)
5065 END DO
5066
5067 DO iat = 1, rmsd_atom
5068 ii = iatom(iat)
5069 riat(:, iat) = particles(ii)%r
5070 END DO
5071
5072 DO ik = 1, nconf
5073 DO i = 1, natom
5074 ii = (i - 1)*3
5075 r(ii + 1) = path_conf(ii + 1, ik)
5076 r(ii + 2) = path_conf(ii + 2, ik)
5077 r(ii + 3) = path_conf(ii + 3, ik)
5078 END DO
5079
5080 CALL rmsd3(particles, r, r0, output_unit=-1, rotate=.true.)
5081
5082 sum_exp = 0.0_dp
5083 DO iat = 1, rmsd_atom
5084 i = iatom(iat)
5085 ii = (i - 1)*3
5086 vec_dif(iat) = (riat(1, iat) - r(ii + 1))**2 + (riat(2, iat) - r(ii + 2))**2 + (riat(3, iat) - r(ii + 3))**2
5087 sum_exp = sum_exp + vec_dif(iat)
5088 dvec_dif(1, iat) = r(ii + 1)
5089 dvec_dif(2, iat) = r(ii + 2)
5090 dvec_dif(3, iat) = r(ii + 3)
5091 END DO
5092 s1v(ik) = exp(-lambda*sum_exp)
5093 DO iat = 1, rmsd_atom
5094 ds1v(1, iat, ik) = dvec_dif(1, iat)*s1v(ik)
5095 ds1v(2, iat, ik) = dvec_dif(2, iat)*s1v(ik)
5096 ds1v(3, iat, ik) = dvec_dif(3, iat)*s1v(ik)
5097 END DO
5098 END DO
5099
5100 s1 = accurate_sum(s1v(:))
5101 DO iat = 1, rmsd_atom
5102 ds1(1, iat) = accurate_sum(ds1v(1, iat, :))
5103 ds1(2, iat) = accurate_sum(ds1v(2, iat, :))
5104 ds1(3, iat) = accurate_sum(ds1v(3, iat, :))
5105 END DO
5106 colvar%ss = -1.0_dp/lambda*log(s1)
5107
5108 ALLOCATE (fi(3, rmsd_atom))
5109
5110 DO iat = 1, rmsd_atom
5111 fi(:, iat) = 2.0_dp*(riat(:, iat) - ds1(:, iat)/s1)
5112 CALL put_derivative(colvar, iat, fi(:, iat))
5113 END DO
5114
5115 DEALLOCATE (fi)
5116 DEALLOCATE (r0)
5117 DEALLOCATE (r)
5118 DEALLOCATE (riat)
5119 DEALLOCATE (vec_dif)
5120 DEALLOCATE (dvec_dif)
5121 DEALLOCATE (s1v)
5122 DEALLOCATE (ds1v)
5123 DEALLOCATE (ds1)
5124 END SUBROUTINE dpath_dist_rmsd
5125
5126! **************************************************************************************************
5127!> \brief ...
5128!> \param colvar ...
5129!> \param particles ...
5130! **************************************************************************************************
5131 SUBROUTINE dpath_rmsd(colvar, particles)
5132
5133 TYPE(colvar_type), POINTER :: colvar
5134 TYPE(particle_type), DIMENSION(:), POINTER :: particles
5135
5136 INTEGER :: i, iat, ii, ik, natom, nconf, rmsd_atom
5137 INTEGER, DIMENSION(:), POINTER :: iatom
5138 REAL(dp) :: lambda, my_rmsd, s1
5139 REAL(dp), ALLOCATABLE, DIMENSION(:) :: r, r0, s1v
5140 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: ds1, fi, riat
5141 REAL(dp), ALLOCATABLE, DIMENSION(:, :, :) :: ds1v
5142 REAL(dp), DIMENSION(:, :), POINTER :: path_conf
5143 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: weight
5144 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: drmsd
5145
5146 nconf = colvar%reaction_path_param%nr_frames
5147 rmsd_atom = colvar%reaction_path_param%n_components
5148 lambda = colvar%reaction_path_param%lambda
5149 path_conf => colvar%reaction_path_param%r_ref
5150 iatom => colvar%reaction_path_param%i_rmsd
5151
5152 natom = SIZE(particles)
5153
5154 ALLOCATE (r0(3*natom))
5155 ALLOCATE (r(3*natom))
5156 ALLOCATE (riat(3, rmsd_atom))
5157 ALLOCATE (s1v(nconf))
5158 ALLOCATE (ds1v(3, rmsd_atom, nconf))
5159 ALLOCATE (ds1(3, rmsd_atom))
5160 ALLOCATE (drmsd(3, natom))
5161 drmsd = 0.0_dp
5162 ALLOCATE (weight(natom))
5163
5164 DO i = 1, natom
5165 ii = (i - 1)*3
5166 r0(ii + 1) = particles(i)%r(1)
5167 r0(ii + 2) = particles(i)%r(2)
5168 r0(ii + 3) = particles(i)%r(3)
5169 END DO
5170
5171 DO iat = 1, rmsd_atom
5172 ii = iatom(iat)
5173 riat(:, iat) = particles(ii)%r
5174 END DO
5175
5176! set weights of atoms in the rmsd list
5177 weight = 0.0_dp
5178 DO iat = 1, rmsd_atom
5179 i = iatom(iat)
5180 weight(i) = 1.0_dp
5181 END DO
5182
5183 DO ik = 1, nconf
5184 DO i = 1, natom
5185 ii = (i - 1)*3
5186 r(ii + 1) = path_conf(ii + 1, ik)
5187 r(ii + 2) = path_conf(ii + 2, ik)
5188 r(ii + 3) = path_conf(ii + 3, ik)
5189 END DO
5190
5191 CALL rmsd3(particles, r0, r, output_unit=-1, weights=weight, my_val=my_rmsd, &
5192 rotate=.false., drmsd3=drmsd)
5193
5194 s1v(ik) = exp(-lambda*my_rmsd)
5195 DO iat = 1, rmsd_atom
5196 i = iatom(iat)
5197 ds1v(1, iat, ik) = drmsd(1, i)*s1v(ik)
5198 ds1v(2, iat, ik) = drmsd(2, i)*s1v(ik)
5199 ds1v(3, iat, ik) = drmsd(3, i)*s1v(ik)
5200 END DO
5201 END DO
5202
5203 s1 = accurate_sum(s1v(:))
5204 DO iat = 1, rmsd_atom
5205 ds1(1, iat) = accurate_sum(ds1v(1, iat, :))
5206 ds1(2, iat) = accurate_sum(ds1v(2, iat, :))
5207 ds1(3, iat) = accurate_sum(ds1v(3, iat, :))
5208 END DO
5209 colvar%ss = -1.0_dp/lambda*log(s1)
5210
5211 ALLOCATE (fi(3, rmsd_atom))
5212
5213 DO iat = 1, rmsd_atom
5214 fi(:, iat) = ds1(:, iat)/s1
5215 CALL put_derivative(colvar, iat, fi(:, iat))
5216 END DO
5217
5218 DEALLOCATE (fi)
5219 DEALLOCATE (r0)
5220 DEALLOCATE (r)
5221 DEALLOCATE (riat)
5222 DEALLOCATE (s1v)
5223 DEALLOCATE (ds1v)
5224 DEALLOCATE (ds1)
5225 DEALLOCATE (drmsd)
5226 DEALLOCATE (weight)
5227
5228 END SUBROUTINE dpath_rmsd
5229
5230! **************************************************************************************************
5231!> \brief evaluates the force due to population colvar
5232!> \param colvar ...
5233!> \param cell ...
5234!> \param subsys ...
5235!> \param particles ...
5236!> \date 01.2009
5237!> \author fsterpone
5238! **************************************************************************************************
5239 SUBROUTINE population_colvar(colvar, cell, subsys, particles)
5240 TYPE(colvar_type), POINTER :: colvar
5241 TYPE(cell_type), POINTER :: cell
5242 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
5243 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
5244 POINTER :: particles
5245
5246 INTEGER :: i, ii, jj, n_atoms_from, n_atoms_to, &
5247 ndcrd, nncrd
5248 REAL(dp) :: dfunc, dfunc_coord, ftmp(3), func, func_coord, inv_n_atoms_from, invden, n_0, &
5249 ncoord, norm, num, population, r12, r_0, rdist, sigma, ss(3), xij(3)
5250 REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: ftmp_coord
5251 REAL(dp), DIMENSION(3) :: xpi, xpj
5252 TYPE(particle_list_type), POINTER :: particles_i
5253 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
5254
5255! If we defined the coordination number with KINDS then we have still
5256! to fill few missing informations...
5257
5258 NULLIFY (particles_i)
5259 cpassert(colvar%type_id == population_colvar_id)
5260 IF (PRESENT(particles)) THEN
5261 my_particles => particles
5262 ELSE
5263 cpassert(PRESENT(subsys))
5264 CALL cp_subsys_get(subsys, particles=particles_i)
5265 my_particles => particles_i%els
5266 END IF
5267 n_atoms_to = colvar%population_param%n_atoms_to
5268 n_atoms_from = colvar%population_param%n_atoms_from
5269 nncrd = colvar%population_param%nncrd
5270 ndcrd = colvar%population_param%ndcrd
5271 r_0 = colvar%population_param%r_0
5272 n_0 = colvar%population_param%n0
5273 sigma = colvar%population_param%sigma
5274
5275 ALLOCATE (ftmp_coord(3, n_atoms_to))
5276 ftmp_coord = 0.0_dp
5277
5278 ncoord = 0.0_dp
5279 population = 0.0_dp
5280
5281 colvar%dsdr = 0.0_dp
5282 inv_n_atoms_from = 1.0_dp/real(n_atoms_from, kind=dp)
5283
5284 norm = sqrt(pi*2.0_dp)*sigma
5285 norm = 1/norm
5286
5287 DO ii = 1, n_atoms_from
5288 i = colvar%population_param%i_at_from(ii)
5289 CALL get_coordinates(colvar, i, xpi, my_particles)
5290 DO jj = 1, n_atoms_to
5291 i = colvar%population_param%i_at_to(jj)
5292 CALL get_coordinates(colvar, i, xpj, my_particles)
5293 ss = matmul(cell%h_inv, xpi(:) - xpj(:))
5294 ss = ss - nint(ss)
5295 xij = matmul(cell%hmat, ss)
5296 r12 = sqrt(xij(1)**2 + xij(2)**2 + xij(3)**2)
5297 IF (r12 < 1.0e-8_dp) cycle
5298 rdist = r12/r_0
5299 num = (1.0_dp - rdist**nncrd)
5300 invden = 1.0_dp/(1.0_dp - rdist**ndcrd)
5301 func_coord = num*invden
5302 dfunc_coord = (-nncrd*rdist**(nncrd - 1)*invden &
5303 + num*(invden)**2*ndcrd*rdist**(ndcrd - 1))/(r12*r_0)
5304
5305 ncoord = ncoord + func_coord
5306 ftmp_coord(1, jj) = dfunc_coord*xij(1)
5307 ftmp_coord(2, jj) = dfunc_coord*xij(2)
5308 ftmp_coord(3, jj) = dfunc_coord*xij(3)
5309 END DO
5310
5311 func = exp(-(ncoord - n_0)**2/(2.0_dp*sigma*sigma))
5312 dfunc = -func*(ncoord - n_0)/(sigma*sigma)
5313
5314 population = population + norm*func
5315 DO jj = 1, n_atoms_to
5316 ftmp(1) = ftmp_coord(1, jj)*dfunc
5317 ftmp(2) = ftmp_coord(2, jj)*dfunc
5318 ftmp(3) = ftmp_coord(3, jj)*dfunc
5319 CALL put_derivative(colvar, ii, ftmp)
5320 ftmp(1) = -ftmp_coord(1, jj)*dfunc
5321 ftmp(2) = -ftmp_coord(2, jj)*dfunc
5322 ftmp(3) = -ftmp_coord(3, jj)*dfunc
5323 CALL put_derivative(colvar, n_atoms_from + jj, ftmp)
5324 END DO
5325 ncoord = 0.0_dp
5326 END DO
5327 colvar%ss = population
5328 END SUBROUTINE population_colvar
5329
5330! **************************************************************************************************
5331!> \brief evaluates the force due to the gyration radius colvar
5332!> sum_i (r_i-rcom)^2/N
5333!> \param colvar ...
5334!> \param cell ...
5335!> \param subsys ...
5336!> \param particles ...
5337!> \date 03.2009
5338!> \author MI
5339! **************************************************************************************************
5340 SUBROUTINE gyration_radius_colvar(colvar, cell, subsys, particles)
5341
5342 TYPE(colvar_type), POINTER :: colvar
5343 TYPE(cell_type), POINTER :: cell
5344 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
5345 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
5346 POINTER :: particles
5347
5348 INTEGER :: i, ii, n_atoms
5349 REAL(dp) :: dri2, func, gyration, inv_n, mass_tot, mi
5350 REAL(dp), DIMENSION(3) :: dfunc, dxi, ftmp, ss, xpcom, xpi
5351 TYPE(particle_list_type), POINTER :: particles_i
5352 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
5353
5354 NULLIFY (particles_i, my_particles)
5355 cpassert(colvar%type_id == gyration_colvar_id)
5356 IF (PRESENT(particles)) THEN
5357 my_particles => particles
5358 ELSE
5359 cpassert(PRESENT(subsys))
5360 CALL cp_subsys_get(subsys, particles=particles_i)
5361 my_particles => particles_i%els
5362 END IF
5363 n_atoms = colvar%gyration_param%n_atoms
5364 inv_n = 1.0_dp/n_atoms
5365
5366 !compute COM position
5367 xpcom = 0.0_dp
5368 mass_tot = 0.0_dp
5369 DO ii = 1, n_atoms
5370 i = colvar%gyration_param%i_at(ii)
5371 CALL get_coordinates(colvar, i, xpi, my_particles)
5372 CALL get_mass(colvar, i, mi, my_particles)
5373 xpcom(:) = xpcom(:) + xpi(:)*mi
5374 mass_tot = mass_tot + mi
5375 END DO
5376 xpcom(:) = xpcom(:)/mass_tot
5377
5378 func = 0.0_dp
5379 ftmp = 0.0_dp
5380 dfunc = 0.0_dp
5381 DO ii = 1, n_atoms
5382 i = colvar%gyration_param%i_at(ii)
5383 CALL get_coordinates(colvar, i, xpi, my_particles)
5384 ss = matmul(cell%h_inv, xpi(:) - xpcom(:))
5385 ss = ss - nint(ss)
5386 dxi = matmul(cell%hmat, ss)
5387 dri2 = (dxi(1)**2 + dxi(2)**2 + dxi(3)**2)
5388 func = func + dri2
5389 dfunc(:) = dfunc(:) + dxi(:)
5390 END DO
5391 gyration = sqrt(inv_n*func)
5392
5393 DO ii = 1, n_atoms
5394 i = colvar%gyration_param%i_at(ii)
5395 CALL get_coordinates(colvar, i, xpi, my_particles)
5396 CALL get_mass(colvar, i, mi, my_particles)
5397 ss = matmul(cell%h_inv, xpi(:) - xpcom(:))
5398 ss = ss - nint(ss)
5399 dxi = matmul(cell%hmat, ss)
5400 ftmp(1) = dxi(1) - dfunc(1)*mi/mass_tot
5401 ftmp(2) = dxi(2) - dfunc(2)*mi/mass_tot
5402 ftmp(3) = dxi(3) - dfunc(3)*mi/mass_tot
5403 ftmp(:) = ftmp(:)*inv_n/gyration
5404 CALL put_derivative(colvar, ii, ftmp)
5405 END DO
5406 colvar%ss = gyration
5407
5408 END SUBROUTINE gyration_radius_colvar
5409
5410! **************************************************************************************************
5411!> \brief evaluates the force due to the rmsd colvar
5412!> \param colvar ...
5413!> \param subsys ...
5414!> \param particles ...
5415!> \date 12.2009
5416!> \author MI
5417!> \note could be extended to be used with more than 2 reference structures
5418! **************************************************************************************************
5419 SUBROUTINE rmsd_colvar(colvar, subsys, particles)
5420 TYPE(colvar_type), POINTER :: colvar
5421 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
5422 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
5423 POINTER :: particles
5424
5425 CALL rmsd_colvar_low(colvar, subsys, particles)
5426 END SUBROUTINE rmsd_colvar
5427
5428! **************************************************************************************************
5429!> \brief evaluates the force due to the rmsd colvar
5430!> ss = (RMSDA-RMSDB)/(RMSDA+RMSDB)
5431!> RMSD is calculated with respect to two reference structures, A and B,
5432!> considering all the atoms of the system or only a subset of them,
5433!> as selected by the input keyword LIST
5434!> \param colvar ...
5435!> \param subsys ...
5436!> \param particles ...
5437!> \date 12.2009
5438!> \par History TL 2012 (generalized to any number of frames)
5439!> \author MI
5440! **************************************************************************************************
5441 SUBROUTINE rmsd_colvar_low(colvar, subsys, particles)
5442
5443 TYPE(colvar_type), POINTER :: colvar
5444 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
5445 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
5446 POINTER :: particles
5447
5448 INTEGER :: i, ii, natom, nframes
5449 REAL(kind=dp) :: cv_val, f1, ftmp(3)
5450 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: der, r, rmsd
5451 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: r0
5452 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: drmsd
5453 REAL(kind=dp), DIMENSION(:), POINTER :: weights
5454 TYPE(particle_list_type), POINTER :: particles_i
5455 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
5456
5457 NULLIFY (my_particles, particles_i, weights)
5458 cpassert(colvar%type_id == rmsd_colvar_id)
5459 IF (PRESENT(particles)) THEN
5460 my_particles => particles
5461 ELSE
5462 cpassert(PRESENT(subsys))
5463 CALL cp_subsys_get(subsys, particles=particles_i)
5464 my_particles => particles_i%els
5465 END IF
5466
5467 natom = SIZE(my_particles)
5468 nframes = colvar%rmsd_param%nr_frames
5469 ALLOCATE (drmsd(3, natom, nframes))
5470 drmsd = 0.0_dp
5471
5472 ALLOCATE (r0(3*natom, nframes))
5473 ALLOCATE (rmsd(nframes))
5474 ALLOCATE (der(nframes))
5475 ALLOCATE (r(3*natom))
5476
5477 weights => colvar%rmsd_param%weights
5478 DO i = 1, natom
5479 ii = (i - 1)*3
5480 r(ii + 1) = my_particles(i)%r(1)
5481 r(ii + 2) = my_particles(i)%r(2)
5482 r(ii + 3) = my_particles(i)%r(3)
5483 END DO
5484 r0(:, :) = colvar%rmsd_param%r_ref
5485 rmsd = 0.0_dp
5486
5487 CALL rmsd3(my_particles, r, r0(:, 1), output_unit=-1, weights=weights, my_val=rmsd(1), rotate=.false., drmsd3=drmsd(:, :, 1))
5488
5489 IF (nframes == 2) THEN
5490 CALL rmsd3(my_particles, r, r0(:, 2), output_unit=-1, weights=weights, &
5491 my_val=rmsd(2), rotate=.false., drmsd3=drmsd(:, :, 2))
5492
5493 f1 = 1.0_dp/(rmsd(1) + rmsd(2))
5494 ! (rmsdA-rmsdB)/(rmsdA+rmsdB)
5495 cv_val = (rmsd(1) - rmsd(2))*f1
5496 ! (rmsdA+rmsdB)^-1-(rmsdA-rmsdB)/(rmsdA+rmsdB)^2
5497 der(1) = f1 - cv_val*f1
5498 ! -(rmsdA+rmsdB)^-1-(rmsdA-rmsdB)/(rmsdA+rmsdB)^2
5499 der(2) = -f1 - cv_val*f1
5500
5501 DO i = 1, colvar%rmsd_param%n_atoms
5502 ii = colvar%rmsd_param%i_rmsd(i)
5503 IF (weights(ii) > 0.0_dp) THEN
5504 ftmp(1) = der(1)*drmsd(1, ii, 1) + der(2)*drmsd(1, ii, 2)
5505 ftmp(2) = der(1)*drmsd(2, ii, 1) + der(2)*drmsd(2, ii, 2)
5506 ftmp(3) = der(1)*drmsd(3, ii, 1) + der(2)*drmsd(3, ii, 2)
5507 CALL put_derivative(colvar, i, ftmp)
5508 END IF
5509 END DO
5510 ELSE IF (nframes == 1) THEN
5511 ! Protect in case of numerical issues (for two identical frames!)
5512 rmsd(1) = abs(rmsd(1))
5513 cv_val = sqrt(rmsd(1))
5514 f1 = 0.0_dp
5515 IF (cv_val /= 0.0_dp) f1 = 0.5_dp/cv_val
5516 DO i = 1, colvar%rmsd_param%n_atoms
5517 ii = colvar%rmsd_param%i_rmsd(i)
5518 IF (weights(ii) > 0.0_dp) THEN
5519 ftmp(1) = f1*drmsd(1, ii, 1)
5520 ftmp(2) = f1*drmsd(2, ii, 1)
5521 ftmp(3) = f1*drmsd(3, ii, 1)
5522 CALL put_derivative(colvar, i, ftmp)
5523 END IF
5524 END DO
5525 ELSE
5526 cpabort("RMSD implemented only for 1 and 2 reference frames!")
5527 END IF
5528 colvar%ss = cv_val
5529
5530 DEALLOCATE (der)
5531 DEALLOCATE (r0)
5532 DEALLOCATE (r)
5533 DEALLOCATE (drmsd)
5534 DEALLOCATE (rmsd)
5535
5536 END SUBROUTINE rmsd_colvar_low
5537
5538! **************************************************************************************************
5539!> \brief evaluates the force from ring puckering collective variables
5540!> Cramer and Pople, JACS 97 1354 (1975)
5541!> \param colvar ...
5542!> \param cell ...
5543!> \param subsys ...
5544!> \param particles ...
5545!> \date 08.2012
5546!> \author JGH
5547! **************************************************************************************************
5548 SUBROUTINE ring_puckering_colvar(colvar, cell, subsys, particles)
5549 TYPE(colvar_type), POINTER :: colvar
5550 TYPE(cell_type), POINTER :: cell
5551 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
5552 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
5553 POINTER :: particles
5554
5555 INTEGER :: i, ii, j, jj, m, nring
5556 REAL(kind=dp) :: a, at, b, da, db, ds, kr, rpxpp, svar
5557 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: cosj, sinj, z
5558 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: r
5559 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: nforce, zforce
5560 REAL(kind=dp), DIMENSION(3) :: ftmp, nv, r0, rp, rpp, uv
5561 REAL(kind=dp), DIMENSION(3, 3) :: dnvp, dnvpp
5562 TYPE(particle_list_type), POINTER :: particles_i
5563 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
5564
5565 cpassert(colvar%type_id == ring_puckering_colvar_id)
5566 IF (PRESENT(particles)) THEN
5567 my_particles => particles
5568 ELSE
5569 cpassert(PRESENT(subsys))
5570 CALL cp_subsys_get(subsys, particles=particles_i)
5571 my_particles => particles_i%els
5572 END IF
5573
5574 nring = colvar%ring_puckering_param%nring
5575 ALLOCATE (r(3, nring), z(nring), cosj(nring), sinj(nring))
5576 ALLOCATE (nforce(3, 3, nring), zforce(nring, nring, 3))
5577 DO ii = 1, nring
5578 i = colvar%ring_puckering_param%atoms(ii)
5579 CALL get_coordinates(colvar, i, r(:, ii), my_particles)
5580 END DO
5581 ! get all atoms within PBC distance of atom 1
5582 r0(:) = r(:, 1)
5583 DO ii = 1, nring
5584 r(:, ii) = pbc(r(:, ii), r0, cell)
5585 END DO
5586 !compute origin position
5587 r0 = 0.0_dp
5588 DO ii = 1, nring
5589 r0(:) = r0(:) + r(:, ii)
5590 END DO
5591 kr = 1._dp/real(nring, kind=dp)
5592 r0(:) = r0(:)*kr
5593 DO ii = 1, nring
5594 r(:, ii) = r(:, ii) - r0(:)
5595 END DO
5596 ! orientation vectors
5597 rp = 0._dp
5598 rpp = 0._dp
5599 DO ii = 1, nring
5600 cosj(ii) = cos(twopi*(ii - 1)*kr)
5601 sinj(ii) = sin(twopi*(ii - 1)*kr)
5602 rp(:) = rp(:) + r(:, ii)*sinj(ii)
5603 rpp(:) = rpp(:) + r(:, ii)*cosj(ii)
5604 END DO
5605 nv = vector_product(rp, rpp)
5606 nv = nv/sqrt(sum(nv**2))
5607
5608 ! derivatives of normal
5609 uv = vector_product(rp, rpp)
5610 rpxpp = sqrt(sum(uv**2))
5611 DO i = 1, 3
5612 uv = 0._dp
5613 uv(i) = 1._dp
5614 uv = vector_product(uv, rpp)/rpxpp
5615 dnvp(:, i) = uv - nv*sum(uv*nv)
5616 uv = 0._dp
5617 uv(i) = 1._dp
5618 uv = vector_product(rp, uv)/rpxpp
5619 dnvpp(:, i) = uv - nv*sum(uv*nv)
5620 END DO
5621 DO ii = 1, nring
5622 nforce(:, :, ii) = dnvp(:, :)*sinj(ii) + dnvpp(:, :)*cosj(ii)
5623 END DO
5624
5625 ! molecular z-coordinate
5626 DO ii = 1, nring
5627 z(ii) = sum(r(:, ii)*nv(:))
5628 END DO
5629 ! z-force
5630 DO ii = 1, nring
5631 DO jj = 1, nring
5632 IF (ii == jj) THEN
5633 zforce(ii, jj, :) = nv
5634 ELSE
5635 zforce(ii, jj, :) = 0._dp
5636 END IF
5637 DO i = 1, 3
5638 DO j = 1, 3
5639 zforce(ii, jj, i) = zforce(ii, jj, i) + r(j, ii)*nforce(j, i, jj)
5640 END DO
5641 END DO
5642 END DO
5643 END DO
5644
5645 IF (colvar%ring_puckering_param%iq == 0) THEN
5646 ! total puckering amplitude
5647 svar = sqrt(sum(z**2))
5648 DO ii = 1, nring
5649 ftmp = 0._dp
5650 DO jj = 1, nring
5651 ftmp(:) = ftmp(:) + zforce(jj, ii, :)*z(jj)
5652 END DO
5653 ftmp = ftmp/svar
5654 CALL put_derivative(colvar, ii, ftmp)
5655 END DO
5656 ELSE
5657 m = abs(colvar%ring_puckering_param%iq)
5658 cpassert(m /= 1)
5659 IF (mod(nring, 2) == 0 .AND. colvar%ring_puckering_param%iq == nring/2) THEN
5660 ! single puckering amplitude
5661 svar = 0._dp
5662 DO ii = 1, nring
5663 IF (mod(ii, 2) == 0) THEN
5664 svar = svar - z(ii)
5665 ELSE
5666 svar = svar + z(ii)
5667 END IF
5668 END DO
5669 svar = svar*sqrt(kr)
5670 DO ii = 1, nring
5671 ftmp = 0._dp
5672 DO jj = 1, nring
5673 IF (mod(jj, 2) == 0) THEN
5674 ftmp(:) = ftmp(:) - zforce(jj, ii, :)*sqrt(kr)
5675 ELSE
5676 ftmp(:) = ftmp(:) + zforce(jj, ii, :)*sqrt(kr)
5677 END IF
5678 END DO
5679 CALL put_derivative(colvar, ii, -ftmp)
5680 END DO
5681 ELSE
5682 cpassert(m <= (nring - 1)/2)
5683 a = 0._dp
5684 b = 0._dp
5685 DO ii = 1, nring
5686 a = a + z(ii)*cos(twopi*m*(ii - 1)*kr)
5687 b = b - z(ii)*sin(twopi*m*(ii - 1)*kr)
5688 END DO
5689 a = a*sqrt(2._dp*kr)
5690 b = b*sqrt(2._dp*kr)
5691 IF (colvar%ring_puckering_param%iq > 0) THEN
5692 ! puckering amplitude
5693 svar = sqrt(a*a + b*b)
5694 da = a/svar
5695 db = b/svar
5696 ELSE
5697 ! puckering phase angle
5698 at = atan2(a, b)
5699 IF (at > pi/2._dp) THEN
5700 svar = 2.5_dp*pi - at
5701 ELSE
5702 svar = 0.5_dp*pi - at
5703 END IF
5704 da = -b/(a*a + b*b)
5705 db = a/(a*a + b*b)
5706 END IF
5707 DO jj = 1, nring
5708 ftmp = 0._dp
5709 DO ii = 1, nring
5710 ds = da*cos(twopi*m*(ii - 1)*kr)
5711 ds = ds - db*sin(twopi*m*(ii - 1)*kr)
5712 ftmp(:) = ftmp(:) + ds*sqrt(2._dp*kr)*zforce(ii, jj, :)
5713 END DO
5714 CALL put_derivative(colvar, jj, ftmp)
5715 END DO
5716 END IF
5717 END IF
5718
5719 colvar%ss = svar
5720
5721 DEALLOCATE (r, z, cosj, sinj, nforce, zforce)
5722
5723 END SUBROUTINE ring_puckering_colvar
5724
5725! **************************************************************************************************
5726!> \brief used to print reaction_path function values on an arbitrary dimensional grid
5727!> \param iw1 ...
5728!> \param ncol ...
5729!> \param f_vals ...
5730!> \param v_count ...
5731!> \param gp ...
5732!> \param grid_sp ...
5733!> \param step_size ...
5734!> \param istart ...
5735!> \param iend ...
5736!> \param s1v ...
5737!> \param s1 ...
5738!> \param p_bounds ...
5739!> \param lambda ...
5740!> \param ifunc ...
5741!> \param nconf ...
5742!> \return ...
5743!> \author fschiff
5744! **************************************************************************************************
5745 RECURSIVE FUNCTION rec_eval_grid(iw1, ncol, f_vals, v_count, &
5746 gp, grid_sp, step_size, istart, iend, s1v, s1, p_bounds, lambda, ifunc, nconf) RESULT(k)
5747 INTEGER :: iw1, ncol
5748 REAL(dp), DIMENSION(:, :), POINTER :: f_vals
5749 INTEGER :: v_count
5750 REAL(dp), DIMENSION(:), POINTER :: gp, grid_sp
5751 REAL(dp) :: step_size
5752 INTEGER :: istart, iend
5753 REAL(dp), DIMENSION(:, :), POINTER :: s1v
5754 REAL(dp), DIMENSION(:), POINTER :: s1
5755 INTEGER, DIMENSION(:, :), POINTER :: p_bounds
5756 REAL(dp) :: lambda
5757 INTEGER :: ifunc, nconf, k
5758
5759 INTEGER :: count1, i
5760
5761 k = 1
5762 IF (v_count < ncol) THEN
5763 count1 = v_count + 1
5764 DO i = p_bounds(1, count1), p_bounds(2, count1)
5765 gp(count1) = real(i, kind=dp)*grid_sp(count1)
5766 k = rec_eval_grid(iw1, ncol, f_vals, count1, gp, grid_sp, step_size, &
5767 istart, iend, s1v, s1, p_bounds, lambda, ifunc, nconf)
5768 END DO
5769 ELSE IF (v_count == ncol .AND. ifunc == 1) THEN
5770 DO i = istart, iend
5771 s1v(1, i) = real(i, kind=dp)*step_size*exp(-lambda*dot_product(gp(:) - f_vals(:, i), &
5772 gp(:) - f_vals(:, i)))
5773 s1v(2, i) = exp(-lambda*dot_product(gp(:) - f_vals(:, i), gp(:) - f_vals(:, i)))
5774 END DO
5775 DO i = 1, 2
5776 s1(i) = accurate_sum(s1v(i, :))
5777 END DO
5778 WRITE (iw1, '(5F10.5)') gp(:), s1(1)/s1(2)/real(nconf - 1, dp)
5779 ELSE IF (v_count == ncol .AND. ifunc == 2) THEN
5780 DO i = istart, iend
5781 s1v(1, i) = exp(-lambda*dot_product(gp(:) - f_vals(:, i), gp(:) - f_vals(:, i)))
5782 END DO
5783 s1(1) = accurate_sum(s1v(1, :))
5784
5785 WRITE (iw1, '(5F10.5)') gp(:), -lambda*log(s1(1))
5786 END IF
5787 END FUNCTION rec_eval_grid
5788
5789! **************************************************************************************************
5790!> \brief Reads the coordinates of reference configurations given in input
5791!> either as xyz files or in &COORD section
5792!> \param frame_section ...
5793!> \param para_env ...
5794!> \param nr_frames ...
5795!> \param r_ref ...
5796!> \param n_atoms ...
5797!> \date 01.2010
5798!> \author MI
5799! **************************************************************************************************
5800 SUBROUTINE read_frames(frame_section, para_env, nr_frames, r_ref, n_atoms)
5801
5802 TYPE(section_vals_type), POINTER :: frame_section
5803 TYPE(mp_para_env_type), POINTER :: para_env
5804 INTEGER, INTENT(IN) :: nr_frames
5805 REAL(dp), DIMENSION(:, :), POINTER :: r_ref
5806 INTEGER, INTENT(OUT) :: n_atoms
5807
5808 CHARACTER(LEN=default_path_length) :: filename
5809 CHARACTER(LEN=default_string_length) :: dummy_char
5810 INTEGER :: i, j, natom
5811 LOGICAL :: explicit, my_end
5812 REAL(kind=dp), DIMENSION(:), POINTER :: rptr
5813 TYPE(section_vals_type), POINTER :: coord_section
5814
5815 NULLIFY (rptr)
5816
5817 DO i = 1, nr_frames
5818 coord_section => section_vals_get_subs_vals(frame_section, "COORD", i_rep_section=i)
5819 CALL section_vals_get(coord_section, explicit=explicit)
5820 ! Cartesian Coordinates
5821 IF (explicit) THEN
5822 CALL section_vals_val_get(coord_section, "_DEFAULT_KEYWORD_", &
5823 n_rep_val=natom)
5824 IF (i == 1) THEN
5825 ALLOCATE (r_ref(3*natom, nr_frames))
5826 n_atoms = natom
5827 ELSE
5828 cpassert(3*natom == SIZE(r_ref, 1))
5829 END IF
5830 DO j = 1, natom
5831 CALL section_vals_val_get(coord_section, "_DEFAULT_KEYWORD_", &
5832 i_rep_val=j, r_vals=rptr)
5833 r_ref((j - 1)*3 + 1:(j - 1)*3 + 3, i) = rptr(1:3)
5834 END DO ! natom
5835 ELSE
5836 block
5837 TYPE(cp_parser_type) :: parser
5838 CALL section_vals_val_get(frame_section, "COORD_FILE_NAME", i_rep_section=i, c_val=filename)
5839 cpassert(trim(filename) /= "")
5840 ALLOCATE (rptr(3))
5841 CALL parser_create(parser, filename, para_env=para_env, parse_white_lines=.true.)
5842 CALL parser_get_next_line(parser, 1)
5843 ! Start parser
5844 CALL parser_get_object(parser, natom)
5845 CALL parser_get_next_line(parser, 1)
5846 IF (i == 1) THEN
5847 ALLOCATE (r_ref(3*natom, nr_frames))
5848 n_atoms = natom
5849 ELSE
5850 cpassert(3*natom == SIZE(r_ref, 1))
5851 END IF
5852 DO j = 1, natom
5853 ! Atom coordinates
5854 CALL parser_get_next_line(parser, 1, at_end=my_end)
5855 IF (my_end) THEN
5856 CALL cp_abort(__location__, &
5857 "Number of lines in XYZ format not equal to the number of atoms."// &
5858 " Error in XYZ format for COORD_A (CV rmsd). Very probably the"// &
5859 " line with title is missing or is empty. Please check the XYZ file and rerun your job!")
5860 END IF
5861 READ (parser%input_line, *) dummy_char, rptr(1:3)
5862 r_ref((j - 1)*3 + 1, i) = cp_unit_to_cp2k(rptr(1), "angstrom")
5863 r_ref((j - 1)*3 + 2, i) = cp_unit_to_cp2k(rptr(2), "angstrom")
5864 r_ref((j - 1)*3 + 3, i) = cp_unit_to_cp2k(rptr(3), "angstrom")
5865 END DO ! natom
5866 CALL parser_release(parser)
5867 END block
5868 DEALLOCATE (rptr)
5869 END IF
5870 END DO ! nr_frames
5871
5872 END SUBROUTINE read_frames
5873
5874! **************************************************************************************************
5875!> \brief evaluates the collective variable associated with a hydrogen bond
5876!> \param colvar ...
5877!> \param cell ...
5878!> \param subsys ...
5879!> \param particles ...
5880!> \param qs_env should be removed
5881!> \author alin m elena
5882! **************************************************************************************************
5883 SUBROUTINE wc_colvar(colvar, cell, subsys, particles, qs_env)
5884 TYPE(colvar_type), POINTER :: colvar
5885 TYPE(cell_type), POINTER :: cell
5886 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
5887 TYPE(particle_type), DIMENSION(:), &
5888 OPTIONAL, POINTER :: particles
5889 TYPE(qs_environment_type), POINTER, OPTIONAL :: qs_env
5890
5891 INTEGER :: od, h, oa
5892 REAL(dp) :: rod(3), roa(3), rh(3), &
5893 x, y, s(3), xv(3), dmin, amin
5894 INTEGER :: idmin, iamin, i, j
5895 TYPE(particle_list_type), POINTER :: particles_i
5896 TYPE(particle_type), DIMENSION(:), &
5897 POINTER :: my_particles
5898 TYPE(wannier_centres_type), DIMENSION(:), POINTER :: wc
5899 INTEGER, ALLOCATABLE :: wcai(:), wcdi(:)
5900 INTEGER :: nwca, nwcd
5901 REAL(dp) :: rcut
5902
5903 NULLIFY (particles_i, wc)
5904
5905 cpassert(colvar%type_id == wc_colvar_id)
5906 IF (PRESENT(particles)) THEN
5907 my_particles => particles
5908 ELSE
5909 cpassert(PRESENT(subsys))
5910 CALL cp_subsys_get(subsys, particles=particles_i)
5911 my_particles => particles_i%els
5912 END IF
5913 CALL get_qs_env(qs_env, wanniercentres=wc)
5914 rcut = colvar%Wc%rcut ! distances are in bohr as far as I remember
5915 od = colvar%Wc%ids(1)
5916 h = colvar%Wc%ids(2)
5917 oa = colvar%Wc%ids(3)
5918 CALL get_coordinates(colvar, od, rod, my_particles)
5919 CALL get_coordinates(colvar, h, rh, my_particles)
5920 CALL get_coordinates(colvar, oa, roa, my_particles)
5921 ALLOCATE (wcai(SIZE(wc(1)%WannierHamDiag)))
5922 ALLOCATE (wcdi(SIZE(wc(1)%WannierHamDiag)))
5923 nwca = 0
5924 nwcd = 0
5925 DO j = 1, SIZE(wc(1)%WannierHamDiag)
5926 x = distance(rod - wc(1)%centres(:, j))
5927 y = distance(roa - wc(1)%centres(:, j))
5928 IF (x < rcut) THEN
5929 nwcd = nwcd + 1
5930 wcdi(nwcd) = j
5931 cycle
5932 END IF
5933 IF (y < rcut) THEN
5934 nwca = nwca + 1
5935 wcai(nwca) = j
5936 END IF
5937 END DO
5938
5939 dmin = distance(rh - wc(1)%centres(:, wcdi(1)))
5940 amin = distance(rh - wc(1)%centres(:, wcai(1)))
5941 idmin = wcdi(1)
5942 iamin = wcai(1)
5943 !dmin constains the smallest numer, amin the next smallest
5944 DO i = 2, nwcd
5945 x = distance(rh - wc(1)%centres(:, wcdi(i)))
5946 IF (x < dmin) THEN
5947 dmin = x
5948 idmin = wcdi(i)
5949 END IF
5950 END DO
5951 DO i = 2, nwca
5952 x = distance(rh - wc(1)%centres(:, wcai(i)))
5953 IF (x < amin) THEN
5954 amin = x
5955 iamin = wcai(i)
5956 END IF
5957 END DO
5958
5959 colvar%ss = wc(1)%WannierHamDiag(idmin) - wc(1)%WannierHamDiag(iamin)
5960 DEALLOCATE (wcai)
5961 DEALLOCATE (wcdi)
5962
5963 CONTAINS
5964! **************************************************************************************************
5965!> \brief ...
5966!> \param rij ...
5967!> \return ...
5968! **************************************************************************************************
5969 REAL(dp) function distance(rij)
5970 REAL(dp), INTENT(in) :: rij(3)
5971
5972 s = matmul(cell%h_inv, rij)
5973 s = s - nint(s)
5974 xv = matmul(cell%hmat, s)
5975 distance = norm2(xv)
5976 END FUNCTION distance
5977
5978 END SUBROUTINE wc_colvar
5979
5980! **************************************************************************************************
5981!> \brief evaluates the collective variable associated with a hydrogen bond wire
5982!> \param colvar ...
5983!> \param cell ...
5984!> \param subsys ...
5985!> \param particles ...
5986!> \param qs_env ...
5987!> \author alin m elena
5988! **************************************************************************************************
5989 SUBROUTINE hbp_colvar(colvar, cell, subsys, particles, qs_env)
5990 TYPE(colvar_type), POINTER :: colvar
5991 TYPE(cell_type), POINTER :: cell
5992 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
5993 TYPE(particle_type), DIMENSION(:), &
5994 OPTIONAL, POINTER :: particles
5995 TYPE(qs_environment_type), OPTIONAL, POINTER :: qs_env
5996
5997 INTEGER :: od, h, oa
5998 REAL(dp) :: rod(3), roa(3), rh(3), &
5999 x, y, s(3), xv(3), dmin, amin
6000 INTEGER :: idmin, iamin, i, j, il, output_unit
6001 TYPE(particle_list_type), POINTER :: particles_i
6002 TYPE(particle_type), DIMENSION(:), &
6003 POINTER :: my_particles
6004 TYPE(wannier_centres_type), &
6005 DIMENSION(:), POINTER :: wc
6006 INTEGER, ALLOCATABLE :: wcai(:), wcdi(:)
6007 INTEGER :: nwca, nwcd
6008 REAL(dp) :: rcut
6009
6010 NULLIFY (particles_i, wc)
6011 output_unit = cp_logger_get_default_io_unit()
6012
6013 cpassert(colvar%type_id == hbp_colvar_id)
6014 IF (PRESENT(particles)) THEN
6015 my_particles => particles
6016 ELSE
6017 cpassert(PRESENT(subsys))
6018 CALL cp_subsys_get(subsys, particles=particles_i)
6019 my_particles => particles_i%els
6020 END IF
6021 CALL get_qs_env(qs_env, wanniercentres=wc)
6022 rcut = colvar%HBP%rcut ! distances are in bohr as far as I remember
6023 ALLOCATE (wcai(SIZE(wc(1)%WannierHamDiag)))
6024 ALLOCATE (wcdi(SIZE(wc(1)%WannierHamDiag)))
6025 colvar%ss = 0.0_dp
6026 DO il = 1, colvar%HBP%nPoints
6027 od = colvar%HBP%ids(il, 1)
6028 h = colvar%HBP%ids(il, 2)
6029 oa = colvar%HBP%ids(il, 3)
6030 CALL get_coordinates(colvar, od, rod, my_particles)
6031 CALL get_coordinates(colvar, h, rh, my_particles)
6032 CALL get_coordinates(colvar, oa, roa, my_particles)
6033 nwca = 0
6034 nwcd = 0
6035 DO j = 1, SIZE(wc(1)%WannierHamDiag)
6036 x = distance(rod - wc(1)%centres(:, j))
6037 y = distance(roa - wc(1)%centres(:, j))
6038 IF (x < rcut) THEN
6039 nwcd = nwcd + 1
6040 wcdi(nwcd) = j
6041 cycle
6042 END IF
6043 IF (y < rcut) THEN
6044 nwca = nwca + 1
6045 wcai(nwca) = j
6046 END IF
6047 END DO
6048
6049 dmin = distance(rh - wc(1)%centres(:, wcdi(1)))
6050 amin = distance(rh - wc(1)%centres(:, wcai(1)))
6051 idmin = wcdi(1)
6052 iamin = wcai(1)
6053 !dmin constains the smallest numer, amin the next smallest
6054 DO i = 2, nwcd
6055 x = distance(rh - wc(1)%centres(:, wcdi(i)))
6056 IF (x < dmin) THEN
6057 dmin = x
6058 idmin = wcdi(i)
6059 END IF
6060 END DO
6061 DO i = 2, nwca
6062 x = distance(rh - wc(1)%centres(:, wcai(i)))
6063 IF (x < amin) THEN
6064 amin = x
6065 iamin = wcai(i)
6066 END IF
6067 END DO
6068 colvar%HBP%ewc(il) = colvar%HBP%shift + wc(1)%WannierHamDiag(idmin) - wc(1)%WannierHamDiag(iamin)
6069 colvar%ss = colvar%ss + colvar%HBP%shift + wc(1)%WannierHamDiag(idmin) - wc(1)%WannierHamDiag(iamin)
6070 END DO
6071 IF (output_unit > 0) THEN
6072 DO il = 1, colvar%HBP%nPoints
6073 WRITE (output_unit, '(a,1(f16.8,1x))') "HBP| = ", colvar%HBP%ewc(il)
6074 END DO
6075 WRITE (output_unit, '(a,1(f16.8,1x))') "HBP|\theta(x) = ", colvar%ss
6076 END IF
6077 DEALLOCATE (wcai)
6078 DEALLOCATE (wcdi)
6079
6080 CONTAINS
6081! **************************************************************************************************
6082!> \brief ...
6083!> \param rij ...
6084!> \return ...
6085! **************************************************************************************************
6086 REAL(dp) function distance(rij)
6087 REAL(dp), INTENT(in) :: rij(3)
6088
6089 s = matmul(cell%h_inv, rij)
6090 s = s - nint(s)
6091 xv = matmul(cell%hmat, s)
6092 distance = norm2(xv)
6093 END FUNCTION distance
6094
6095 END SUBROUTINE hbp_colvar
6096
6097! **************************************************************************************************
6098!> \brief Evaluate the absolute location of a hydronium ion using Voronoi weights
6099!> \param colvar the collective variable
6100!> \param cell the simulation cell
6101!> \param subsys the simulation subsystem
6102!> \param particles the particles, when evaluated for a molecule
6103! **************************************************************************************************
6104 SUBROUTINE colvar_eval_voronoiipz(colvar, cell, subsys, particles)
6105 TYPE(colvar_type), POINTER :: colvar
6106 TYPE(cell_type), POINTER :: cell
6107 TYPE(cp_subsys_type), OPTIONAL, POINTER :: subsys
6108 TYPE(particle_type), DIMENSION(:), OPTIONAL, &
6109 POINTER :: particles
6110
6111 INTEGER :: i, iatom, j, jatom, n_atoms_a, &
6112 n_atoms_o, n_atoms_b, zidx
6113 REAL(kind=dp) :: charge_deriv, cutoff, denominator, &
6114 distance, exponent_max, factor, ion_z, &
6115 lambda, weighted_charge_deriv, zdist, zmid
6116 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: charge, charge_factor
6117 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: inv_distance, weight
6118 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: distance_vector
6119 TYPE(particle_type), DIMENSION(:), POINTER :: my_particles
6120
6121 cpassert(colvar%type_id == voronoiipz_colvar_id)
6122 IF (PRESENT(particles)) THEN
6123 my_particles => particles
6124 ELSE
6125 cpassert(PRESENT(subsys))
6126 my_particles => subsys%particles%els
6127 END IF
6128
6129 n_atoms_a = SIZE(colvar%voronoiipz_params%group_a)
6130 n_atoms_b = SIZE(colvar%voronoiipz_params%group_b)
6131 n_atoms_o = n_atoms_a - colvar%voronoiipz_params%nrx
6132 cutoff = colvar%voronoiipz_params%nl_cutoff
6133 lambda = colvar%voronoiipz_params%lambda
6134 zidx = colvar%voronoiipz_params%zidx
6135 zmid = colvar%voronoiipz_params%zmid
6136
6137 ALLOCATE (charge(n_atoms_a), charge_factor(n_atoms_a))
6138 ALLOCATE (distance_vector(3, n_atoms_a, n_atoms_b))
6139 ALLOCATE (inv_distance(n_atoms_a, n_atoms_b), weight(n_atoms_a, n_atoms_b))
6140 charge = 0.0_dp
6141 charge_factor = 0.0_dp
6142 distance_vector = 0.0_dp
6143 inv_distance = 0.0_dp
6144 weight = 0.0_dp
6145
6146 ! Each hydrogen is assigned continuously to all oxygen sites within the cutoff.
6147 ! Subtracting the largest exponent makes the softmax stable for either sign of lambda.
6148 DO j = 1, n_atoms_b
6149 jatom = colvar%voronoiipz_params%group_b(j)
6150 exponent_max = -huge(0.0_dp)
6151 DO i = 1, n_atoms_a
6152 iatom = colvar%voronoiipz_params%group_a(i)
6153 distance_vector(:, i, j) = pbc(my_particles(iatom)%r, my_particles(jatom)%r, cell)
6154 distance = norm2(distance_vector(:, i, j))
6155 IF (distance <= cutoff) THEN
6156 IF (distance <= epsilon(0.0_dp)) THEN
6157 cpabort("VORONOIIPZ is undefined for coincident GROUPA and GROUPB atoms")
6158 END IF
6159 inv_distance(i, j) = 1.0_dp/distance
6160 weight(i, j) = lambda*distance
6161 exponent_max = max(exponent_max, weight(i, j))
6162 END IF
6163 END DO
6164
6165 denominator = 0.0_dp
6166 DO i = 1, n_atoms_a
6167 IF (inv_distance(i, j) > 0.0_dp) THEN
6168 weight(i, j) = exp(weight(i, j) - exponent_max)
6169 denominator = denominator + weight(i, j)
6170 END IF
6171 END DO
6172 IF (denominator <= 0.0_dp) THEN
6173 cpabort("VORONOIIPZ found a GROUPB atom without a GROUPA neighbor inside NL_CUTOFF")
6174 END IF
6175 weight(:, j) = weight(:, j)/denominator
6176 END DO
6177
6178 charge(:) = sum(weight, dim=2)
6179 DO i = 1, n_atoms_a
6180 IF (i <= n_atoms_o) THEN
6181 charge(i) = charge(i) - colvar%voronoiipz_params%d0
6182 ELSE
6183 SELECT CASE (i - n_atoms_o)
6184 CASE (1)
6185 charge(i) = charge(i) - colvar%voronoiipz_params%d1
6186 CASE (2)
6187 charge(i) = charge(i) - colvar%voronoiipz_params%d2
6188 CASE (3)
6189 charge(i) = charge(i) - colvar%voronoiipz_params%d3
6190 END SELECT
6191 END IF
6192 END DO
6193
6194 ion_z = 0.0_dp
6195 DO i = 1, n_atoms_o
6196 IF (charge(i) > 0.0_dp) THEN
6197 iatom = colvar%voronoiipz_params%group_a(i)
6198 zdist = my_particles(iatom)%r(zidx) - zmid
6199 ion_z = ion_z + abs(zdist)*charge(i)**2
6200 charge_factor(i) = 2.0_dp*abs(zdist)*charge(i)
6201 IF (zdist > 0.0_dp) THEN
6202 colvar%dsdr(zidx, i) = colvar%dsdr(zidx, i) + charge(i)**2
6203 ELSE IF (zdist < 0.0_dp) THEN
6204 colvar%dsdr(zidx, i) = colvar%dsdr(zidx, i) - charge(i)**2
6205 END IF
6206 END IF
6207 END DO
6208
6209 ! ds/d(r_ij) = lambda*w_ij*(ds/dq_i - sum_k(w_kj*ds/dq_k)).
6210 DO j = 1, n_atoms_b
6211 weighted_charge_deriv = sum(weight(:, j)*charge_factor)
6212 DO i = 1, n_atoms_a
6213 IF (weight(i, j) > 0.0_dp) THEN
6214 charge_deriv = charge_factor(i) - weighted_charge_deriv
6215 factor = lambda*weight(i, j)*charge_deriv*inv_distance(i, j)
6216 colvar%dsdr(:, i) = colvar%dsdr(:, i) - factor*distance_vector(:, i, j)
6217 colvar%dsdr(:, n_atoms_a + j) = colvar%dsdr(:, n_atoms_a + j) + &
6218 factor*distance_vector(:, i, j)
6219 END IF
6220 END DO
6221 END DO
6222
6223 colvar%ss = ion_z
6224 DEALLOCATE (charge, charge_factor, distance_vector, inv_distance, weight)
6225
6226 END SUBROUTINE colvar_eval_voronoiipz
6227
6228! **************************************************************************************************
6229!> \brief Read and validate the VORONOIIPZ collective variable
6230!> \param voronoiipz_section the input section
6231!> \param colvar the collective variable
6232! **************************************************************************************************
6233 SUBROUTINE read_voronoiipz_colvars(voronoiipz_section, colvar)
6234 TYPE(section_vals_type), POINTER :: voronoiipz_section
6235 TYPE(colvar_type), POINTER :: colvar
6236
6237 INTEGER :: i, j, n_atoms_a
6238 INTEGER, DIMENSION(:), POINTER :: atom_list
6239
6240 CALL section_vals_val_get(voronoiipz_section, "LAMBDA", r_val=colvar%voronoiipz_params%lambda)
6241 CALL section_vals_val_get(voronoiipz_section, "ZIDX", i_val=colvar%voronoiipz_params%zidx)
6242 CALL section_vals_val_get(voronoiipz_section, "NRX", i_val=colvar%voronoiipz_params%nrx)
6243 CALL section_vals_val_get(voronoiipz_section, "ZMID", r_val=colvar%voronoiipz_params%zmid)
6244 CALL section_vals_val_get(voronoiipz_section, "D_0", r_val=colvar%voronoiipz_params%d0)
6245 CALL section_vals_val_get(voronoiipz_section, "D_1", r_val=colvar%voronoiipz_params%d1)
6246 CALL section_vals_val_get(voronoiipz_section, "D_2", r_val=colvar%voronoiipz_params%d2)
6247 CALL section_vals_val_get(voronoiipz_section, "D_3", r_val=colvar%voronoiipz_params%d3)
6248 CALL section_vals_val_get(voronoiipz_section, "NL_CUTOFF", r_val=colvar%voronoiipz_params%nl_cutoff)
6249
6250 NULLIFY (atom_list)
6251 CALL section_vals_val_get(voronoiipz_section, "GROUPA", i_vals=atom_list)
6252 IF (.NOT. ASSOCIATED(atom_list)) THEN
6253 cpabort("VORONOIIPZ requires a non-empty GROUPA")
6254 END IF
6255 IF (SIZE(atom_list) == 0) cpabort("VORONOIIPZ requires a non-empty GROUPA")
6256 ALLOCATE (colvar%voronoiipz_params%group_a(SIZE(atom_list)))
6257 colvar%voronoiipz_params%group_a = atom_list
6258
6259 NULLIFY (atom_list)
6260 CALL section_vals_val_get(voronoiipz_section, "GROUPB", i_vals=atom_list)
6261 IF (.NOT. ASSOCIATED(atom_list)) THEN
6262 cpabort("VORONOIIPZ requires a non-empty GROUPB")
6263 END IF
6264 IF (SIZE(atom_list) == 0) cpabort("VORONOIIPZ requires a non-empty GROUPB")
6265 ALLOCATE (colvar%voronoiipz_params%group_b(SIZE(atom_list)))
6266 colvar%voronoiipz_params%group_b = atom_list
6267
6268 n_atoms_a = SIZE(colvar%voronoiipz_params%group_a)
6269 IF (colvar%voronoiipz_params%zidx < 1 .OR. colvar%voronoiipz_params%zidx > 3) THEN
6270 cpabort("VORONOIIPZ ZIDX must be 1, 2, or 3")
6271 END IF
6272 IF (colvar%voronoiipz_params%nrx < 0 .OR. colvar%voronoiipz_params%nrx > 3 .OR. &
6273 colvar%voronoiipz_params%nrx >= n_atoms_a) THEN
6274 cpabort("VORONOIIPZ NRX must be between zero and three and smaller than the size of GROUPA")
6275 END IF
6276 IF (colvar%voronoiipz_params%nl_cutoff <= 0.0_dp) THEN
6277 cpabort("VORONOIIPZ NL_CUTOFF must be positive")
6278 END IF
6279 IF (any(colvar%voronoiipz_params%group_a <= 0) .OR. &
6280 any(colvar%voronoiipz_params%group_b <= 0)) THEN
6281 cpabort("VORONOIIPZ atom indices must be positive")
6282 END IF
6283 DO i = 1, n_atoms_a
6284 IF (any(colvar%voronoiipz_params%group_a(i) == colvar%voronoiipz_params%group_a(i + 1:))) THEN
6285 cpabort("VORONOIIPZ GROUPA contains duplicate atom indices")
6286 END IF
6287 IF (any(colvar%voronoiipz_params%group_a(i) == colvar%voronoiipz_params%group_b)) THEN
6288 cpabort("VORONOIIPZ GROUPA and GROUPB must be disjoint")
6289 END IF
6290 END DO
6291 DO j = 1, SIZE(colvar%voronoiipz_params%group_b)
6292 IF (any(colvar%voronoiipz_params%group_b(j) == colvar%voronoiipz_params%group_b(j + 1:))) THEN
6293 cpabort("VORONOIIPZ GROUPB contains duplicate atom indices")
6294 END IF
6295 END DO
6296
6297 END SUBROUTINE read_voronoiipz_colvars
6298
6299END MODULE colvar_methods
cell_types::pbc
Definition cell_types.F:104
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
cp_parser_methods::parser_get_object
Definition cp_parser_methods.F:54
kahan_sum::accurate_sum
Definition kahan_sum.F:41
memory_utilities::reallocate
Definition memory_utilities.F:27
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
cell_types::cell_transform_input_cartesian
subroutine, public cell_transform_input_cartesian(cell, vector)
Transform a Cartesian real-space vector from the user input cell frame into CP2K's canonical internal...
Definition cell_types.F:284
colvar_methods
defines collective variables s({R}) and the derivative of this variable wrt R these can then be used ...
Definition colvar_methods.F:16
colvar_methods::colvar_eval_glob_f
subroutine, public colvar_eval_glob_f(icolvar, force_env)
evaluates the derivatives (dsdr) given and due to the given colvar
Definition colvar_methods.F:1757
colvar_methods::colvar_read
recursive subroutine, public colvar_read(colvar, icol, colvar_section, para_env, cell)
reads a colvar from the input
Definition colvar_methods.F:125
colvar_methods::colvar_eval_mol_f
subroutine, public colvar_eval_mol_f(colvar, cell, particles, pos, fixd_list)
evaluates the derivatives (dsdr) given and due to the given colvar variables in a molecular environme...
Definition colvar_methods.F:1660
colvar_types
Initialize the collective variables types.
Definition colvar_types.F:15
colvar_types::ring_puckering_colvar_id
integer, parameter, public ring_puckering_colvar_id
Definition colvar_types.F:56
colvar_types::population_colvar_id
integer, parameter, public population_colvar_id
Definition colvar_types.F:56
colvar_types::do_clv_geo_center
integer, parameter, public do_clv_geo_center
Definition colvar_types.F:33
colvar_types::voronoiipz_colvar_id
integer, parameter, public voronoiipz_colvar_id
Definition colvar_types.F:56
colvar_types::distance_from_path_colvar_id
integer, parameter, public distance_from_path_colvar_id
Definition colvar_types.F:56
colvar_types::rmsd_colvar_id
integer, parameter, public rmsd_colvar_id
Definition colvar_types.F:56
colvar_types::mindist_colvar_id
integer, parameter, public mindist_colvar_id
Definition colvar_types.F:56
colvar_types::wc_colvar_id
integer, parameter, public wc_colvar_id
Definition colvar_types.F:56
colvar_types::acid_hyd_dist_colvar_id
integer, parameter, public acid_hyd_dist_colvar_id
Definition colvar_types.F:56
colvar_types::xyz_outerdiag_colvar_id
integer, parameter, public xyz_outerdiag_colvar_id
Definition colvar_types.F:56
colvar_types::do_clv_xz
integer, parameter, public do_clv_xz
Definition colvar_types.F:33
colvar_types::plane_plane_angle_colvar_id
integer, parameter, public plane_plane_angle_colvar_id
Definition colvar_types.F:56
colvar_types::colvar_create
subroutine, public colvar_create(colvar, colvar_id)
initializes a colvar_param type
Definition colvar_types.F:432
colvar_types::plane_distance_colvar_id
integer, parameter, public plane_distance_colvar_id
Definition colvar_types.F:56
colvar_types::combine_colvar_id
integer, parameter, public combine_colvar_id
Definition colvar_types.F:56
colvar_types::gyration_colvar_id
integer, parameter, public gyration_colvar_id
Definition colvar_types.F:56
colvar_types::hbp_colvar_id
integer, parameter, public hbp_colvar_id
Definition colvar_types.F:56
colvar_types::rotation_colvar_id
integer, parameter, public rotation_colvar_id
Definition colvar_types.F:56
colvar_types::hydronium_dist_colvar_id
integer, parameter, public hydronium_dist_colvar_id
Definition colvar_types.F:56
colvar_types::coord_colvar_id
integer, parameter, public coord_colvar_id
Definition colvar_types.F:56
colvar_types::do_clv_fix_point
integer, parameter, public do_clv_fix_point
Definition colvar_types.F:33
colvar_types::do_clv_z
integer, parameter, public do_clv_z
Definition colvar_types.F:33
colvar_types::eval_point_pos
subroutine, public eval_point_pos(point, particles, r)
Evaluate the position of the geometrical point.
Definition colvar_types.F:1909
colvar_types::plane_def_atoms
integer, parameter, public plane_def_atoms
Definition colvar_types.F:30
colvar_types::do_clv_yz
integer, parameter, public do_clv_yz
Definition colvar_types.F:33
colvar_types::dfunct_colvar_id
integer, parameter, public dfunct_colvar_id
Definition colvar_types.F:56
colvar_types::angle_colvar_id
integer, parameter, public angle_colvar_id
Definition colvar_types.F:56
colvar_types::qparm_colvar_id
integer, parameter, public qparm_colvar_id
Definition colvar_types.F:56
colvar_types::eval_point_der
subroutine, public eval_point_der(points, i, dsdr, f)
Evaluate the position of the geometrical point.
Definition colvar_types.F:1961
colvar_types::eval_point_mass
subroutine, public eval_point_mass(point, particles, m)
...
Definition colvar_types.F:1934
colvar_types::dist_colvar_id
integer, parameter, public dist_colvar_id
Definition colvar_types.F:56
colvar_types::colvar_setup
subroutine, public colvar_setup(colvar)
Finalize the setup of the collective variable.
Definition colvar_types.F:515
colvar_types::do_clv_xy
integer, parameter, public do_clv_xy
Definition colvar_types.F:33
colvar_types::u_colvar_id
integer, parameter, public u_colvar_id
Definition colvar_types.F:56
colvar_types::hydronium_shell_colvar_id
integer, parameter, public hydronium_shell_colvar_id
Definition colvar_types.F:56
colvar_types::torsion_colvar_id
integer, parameter, public torsion_colvar_id
Definition colvar_types.F:56
colvar_types::do_clv_y
integer, parameter, public do_clv_y
Definition colvar_types.F:33
colvar_types::plane_def_vec
integer, parameter, public plane_def_vec
Definition colvar_types.F:30
colvar_types::xyz_diag_colvar_id
integer, parameter, public xyz_diag_colvar_id
Definition colvar_types.F:56
colvar_types::reaction_path_colvar_id
integer, parameter, public reaction_path_colvar_id
Definition colvar_types.F:56
colvar_types::do_clv_x
integer, parameter, public do_clv_x
Definition colvar_types.F:33
colvar_types::acid_hyd_shell_colvar_id
integer, parameter, public acid_hyd_shell_colvar_id
Definition colvar_types.F:56
constraint_fxd
Definition constraint_fxd.F:12
constraint_fxd::check_fixed_atom_cns_colv
subroutine, public check_fixed_atom_cns_colv(fixd_list, colvar)
...
Definition constraint_fxd.F:388
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
Definition cp_log_handling.F:523
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
cp_output_handling
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
Definition cp_output_handling.F:25
cp_output_handling::cp_print_key_unit_nr
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)
...
Definition cp_output_handling.F:853
cp_output_handling::cp_print_key_finished_output
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,...
Definition cp_output_handling.F:1073
cp_parser_methods
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_methods.F:20
cp_parser_methods::parser_get_next_line
subroutine, public parser_get_next_line(parser, nline, at_end)
Read the next input line and broadcast the input information. Skip (nline-1) lines and skip also all ...
Definition cp_parser_methods.F:421
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_types.F:21
cp_parser_types::parser_release
subroutine, public parser_release(parser)
releases the parser
Definition cp_parser_types.F:109
cp_parser_types::parser_create
subroutine, public parser_create(parser, file_name, unit_nr, para_env, end_section_label, separator_chars, comment_char, continuation_char, quote_char, section_char, parse_white_lines, initial_variables, apply_preprocessing)
Start a parser run. Initial variables allow to @SET stuff before opening the file.
Definition cp_parser_types.F:147
cp_subsys_types
types that represent a subsys, i.e. a part of the system
Definition cp_subsys_types.F:16
cp_subsys_types::cp_subsys_get
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
Definition cp_subsys_types.F:364
cp_units
unit conversion facility
Definition cp_units.F:30
cp_units::cp_unit_to_cp2k
real(kind=dp) function, public cp_unit_to_cp2k(value, unit_str, defaults, power)
converts to the internal cp2k units to the given unit
Definition cp_units.F:1222
force_env_types
Interface for the force calculations.
Definition force_env_types.F:18
force_env_types::use_mixed_force
integer, parameter, public use_mixed_force
Definition force_env_types.F:83
force_env_types::force_env_get
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
Definition force_env_types.F:344
force_fields_util
Definition force_fields_util.F:19
force_fields_util::get_generic_info
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.
Definition force_fields_util.F:1199
fparser
This public domain function parser module is intended for applications where a set of mathematical ex...
Definition fparser.F:17
fparser::parsef
subroutine, public parsef(i, funcstr, var)
Parse ith function string FuncStr and compile it into bytecode.
Definition fparser.F:174
fparser::evalf
real(rn) function, public evalf(i, val)
...
Definition fparser.F:206
fparser::evalerrtype
integer, public evalerrtype
Definition fparser.F:33
fparser::evalfd
real(kind=rn) function, public evalfd(id_fun, ipar, vals, h, err)
Evaluates derivatives.
Definition fparser.F:1097
fparser::finalizef
subroutine, public finalizef()
...
Definition fparser.F:127
fparser::initf
subroutine, public initf(n)
...
Definition fparser.F:156
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:18
input_constants::rmsd_weightlist
integer, parameter, public rmsd_weightlist
Definition input_constants.F:97
input_constants::rmsd_list
integer, parameter, public rmsd_list
Definition input_constants.F:97
input_constants::rmsd_all
integer, parameter, public rmsd_all
Definition input_constants.F:97
input_cp2k_colvar
Definition input_cp2k_colvar.F:13
input_cp2k_colvar::create_colvar_xyz_d_section
subroutine, public create_colvar_xyz_d_section(section)
creates the colvar section regarded to the collective variables dist
Definition input_cp2k_colvar.F:840
input_cp2k_colvar::create_colvar_xyz_od_section
subroutine, public create_colvar_xyz_od_section(section)
creates the colvar section regarded to the collective variables dist
Definition input_cp2k_colvar.F:900
input_enumeration_types
represents an enumeration, i.e. a mapping between integers and strings
Definition input_enumeration_types.F:14
input_enumeration_types::enum_i2c
character(len=default_string_length) function, public enum_i2c(enum, i)
maps an integer to a string
Definition input_enumeration_types.F:152
input_keyword_types
represents keywords in an input
Definition input_keyword_types.F:14
input_keyword_types::keyword_get
subroutine, public keyword_get(keyword, names, usage, description, type_of_var, n_var, default_value, lone_keyword_value, repeats, enum, citations)
...
Definition input_keyword_types.F:489
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_vals_get_subs_vals
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
Definition input_section_types.F:735
input_section_types::section_release
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
Definition input_section_types.F:238
input_section_types::section_get_keyword
recursive type(keyword_type) function, pointer, public section_get_keyword(section, keyword_name)
returns the requested keyword
Definition input_section_types.F:481
input_section_types::section_vals_get
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
Definition input_section_types.F:708
input_section_types::section_vals_val_get
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
Definition input_section_types.F:1052
kahan_sum
sums arrays of real/complex numbers with much reduced round-off as compared to a naive implementation...
Definition kahan_sum.F:29
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition mathconstants.F:110
mathconstants::twopi
real(kind=dp), parameter, public twopi
Definition mathconstants.F:112
mathconstants::maxfac
integer, parameter, public maxfac
Definition mathconstants.F:36
mathconstants::fac
real(kind=dp), dimension(0:maxfac), parameter, public fac
Definition mathconstants.F:37
mathlib
Collection of simple mathematical functions and subroutines.
Definition mathlib.F:15
mathlib::angle
pure real(kind=dp) function, public angle(a, b)
Calculation of the angle between the vectors a and b. The angle is returned in radians.
Definition mathlib.F:184
mathlib::vector_product
pure real(kind=dp) function, dimension(3), public vector_product(a, b)
Calculation of the vector product c = a x b.
Definition mathlib.F:1272
memory_utilities
Utility routines for the memory handling.
Definition memory_utilities.F:14
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
mixed_energy_types
Definition mixed_energy_types.F:12
mixed_environment_utils
Util mixed_environment.
Definition mixed_environment_utils.F:12
mixed_environment_utils::get_subsys_map_index
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
Definition mixed_environment_utils.F:141
molecule_kind_types
Define the molecule kind structure types and the corresponding functionality.
Definition molecule_kind_types.F:16
particle_list_types
represent a simple array based list of the given type
Definition particle_list_types.F:15
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
qs_environment_types
Definition qs_environment_types.F:14
qs_environment_types::get_qs_env
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.
Definition qs_environment_types.F:539
rmsd
Defines functions to perform rmsd in 3D.
Definition rmsd.F:12
rmsd::rmsd3
subroutine, public rmsd3(particle_set, r, r0, output_unit, weights, my_val, rotate, transl, rot, drmsd3)
Computes the RMSD in 3D. Provides also derivatives.
Definition rmsd.F:53
spherical_harmonics
Calculate spherical harmonics.
Definition spherical_harmonics.F:27
spherical_harmonics::legendre
real(kind=dp) function, public legendre(x, l, m)
...
Definition spherical_harmonics.F:1193
spherical_harmonics::dlegendre
real(kind=dp) function, public dlegendre(x, l, m)
...
Definition spherical_harmonics.F:1337
string_utilities
Utilities for string manipulations.
Definition string_utilities.F:16
string_utilities::compress
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
Definition string_utilities.F:3191
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3362
wannier_states_types
defines the type needed for computing wannier states expectations
Definition wannier_states_types.F:12
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
colvar_types::colvar_type
parameters for a collective variable
Definition colvar_types.F:355
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77
cp_subsys_types::cp_subsys_p_type
represent a pointer to a subsys, to be able to create arrays of pointers
Definition cp_subsys_types.F:123
cp_subsys_types::cp_subsys_type
represents a system: atoms, molecules, their pos,vel,...
Definition cp_subsys_types.F:89
force_env_types::force_env_type
wrapper to abstract the force evaluation of the various methods
Definition force_env_types.F:145
input_enumeration_types::enumeration_type
Definition input_enumeration_types.F:43
input_keyword_types::keyword_type
represent a keyword in the input
Definition input_keyword_types.F:89
input_section_types::section_type
represent a section of the input file
Definition input_section_types.F:102
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:767
mixed_energy_types::mixed_force_type
Definition mixed_energy_types.F:28
molecule_kind_types::fixd_constraint_type
Definition molecule_kind_types.F:141
particle_list_types::particle_list_p_type
represents a pointer to a list
Definition particle_list_types.F:59
particle_list_types::particle_list_type
represent a list of objects
Definition particle_list_types.F:46
particle_types::particle_type
Definition particle_types.F:35
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:222
wannier_states_types::wannier_centres_type
Definition wannier_states_types.F:21