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