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