(git:374b731)
Loading...
Searching...
No Matches
colvar_methods.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-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! **************************************************************************************************
16MODULE 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
110CONTAINS
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
6109END MODULE colvar_methods
cell_types::pbc
Definition cell_types.F:92
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
cp_parser_methods::parser_get_object
Definition cp_parser_methods.F:54
kahan_sum::accurate_sum
Definition kahan_sum.F:41
memory_utilities::reallocate
Definition memory_utilities.F:27
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
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::parsef
subroutine, public parsef(i, funcstr, var)
Parse ith function string FuncStr and compile it into bytecode.
Definition fparser.F:148
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
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::angle
pure real(kind=dp) function, public angle(a, b)
Calculation of the angle between the vectors a and b. The angle is returned in radians.
Definition mathlib.F:175
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:1274
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
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:55
colvar_types::colvar_type
parameters for a collective variable
Definition colvar_types.F:346
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77
cp_subsys_types::cp_subsys_p_type
represent a pointer to a subsys, to be able to create arrays of pointers
Definition cp_subsys_types.F:122
cp_subsys_types::cp_subsys_type
represents a system: atoms, molecules, their pos,vel,...
Definition cp_subsys_types.F:89
force_env_types::force_env_type
wrapper to abstract the force evaluation of the various methods
Definition force_env_types.F:139
input_enumeration_types::enumeration_type
Definition input_enumeration_types.F:43
input_keyword_types::keyword_type
represent a keyword in the input
Definition input_keyword_types.F:88
input_section_types::section_type
represent a section of the input file
Definition input_section_types.F:102
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:126
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:763
mixed_energy_types::mixed_force_type
Definition mixed_energy_types.F:28
molecule_kind_types::fixd_constraint_type
Definition molecule_kind_types.F:149
particle_list_types::particle_list_p_type
represents a pointer to a list
Definition particle_list_types.F:59
particle_list_types::particle_list_type
represent a list of objects
Definition particle_list_types.F:46
particle_types::particle_type
Definition particle_types.F:35
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:215
wannier_states_types::wannier_centres_type
Definition wannier_states_types.F:21