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