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