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