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