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