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