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