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