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