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