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