1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2020 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Define the molecule kind structure types and the corresponding 8!> functionality 9!> \par History 10!> Teodoro Laino [tlaino] 12.2008 - Preparing for VIRTUAL SITE constraints 11!> (patch by Marcel Baer) 12!> \author MK (22.08.2003) 13! ************************************************************************************************** 14MODULE molecule_kind_types 15 USE atomic_kind_types, ONLY: atomic_kind_type,& 16 get_atomic_kind 17 USE cell_types, ONLY: use_perd_x,& 18 use_perd_xy,& 19 use_perd_xyz,& 20 use_perd_xz,& 21 use_perd_y,& 22 use_perd_yz,& 23 use_perd_z 24 USE colvar_types, ONLY: & 25 acid_hyd_dist_colvar_id, acid_hyd_shell_colvar_id, angle_colvar_id, colvar_counters, & 26 combine_colvar_id, coord_colvar_id, dfunct_colvar_id, dist_colvar_id, gyration_colvar_id, & 27 hydronium_dist_colvar_id, hydronium_shell_colvar_id, plane_distance_colvar_id, & 28 plane_plane_angle_colvar_id, population_colvar_id, qparm_colvar_id, & 29 reaction_path_colvar_id, rotation_colvar_id, torsion_colvar_id, xyz_diag_colvar_id, & 30 xyz_outerdiag_colvar_id 31 USE cp_log_handling, ONLY: cp_get_default_logger,& 32 cp_logger_type 33 USE cp_output_handling, ONLY: cp_print_key_finished_output,& 34 cp_print_key_unit_nr 35 USE force_field_kind_types, ONLY: & 36 bend_kind_type, bond_kind_type, impr_kind_dealloc_ref, impr_kind_type, opbend_kind_type, & 37 torsion_kind_dealloc_ref, torsion_kind_type, ub_kind_dealloc_ref, ub_kind_type 38 USE input_section_types, ONLY: section_vals_type 39 USE kinds, ONLY: default_string_length,& 40 dp 41 USE shell_potential_types, ONLY: shell_kind_type 42#include "../base/base_uses.f90" 43 44 IMPLICIT NONE 45 46 PRIVATE 47 48 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'molecule_kind_types' 49 50! *** Define the derived structure types *** 51 52! ************************************************************************************************** 53 TYPE atom_type 54 TYPE(atomic_kind_type), POINTER :: atomic_kind 55 INTEGER :: id_name 56 END TYPE atom_type 57 58! ************************************************************************************************** 59 TYPE shell_type 60 INTEGER :: a 61 CHARACTER(LEN=default_string_length) :: name 62 TYPE(shell_kind_type), POINTER :: shell_kind 63 END TYPE shell_type 64 65! ************************************************************************************************** 66 TYPE bond_type 67 INTEGER :: a, b 68 INTEGER :: id_type, itype 69 TYPE(bond_kind_type), POINTER :: bond_kind 70 END TYPE bond_type 71 72! ************************************************************************************************** 73 TYPE bend_type 74 INTEGER :: a, b, c 75 INTEGER :: id_type, itype 76 TYPE(bend_kind_type), POINTER :: bend_kind 77 END TYPE bend_type 78 79! ************************************************************************************************** 80 TYPE ub_type 81 INTEGER :: a, b, c 82 INTEGER :: id_type, itype 83 TYPE(ub_kind_type), POINTER :: ub_kind 84 END TYPE ub_type 85 86! ************************************************************************************************** 87 TYPE torsion_type 88 INTEGER :: a, b, c, d 89 INTEGER :: id_type, itype 90 TYPE(torsion_kind_type), POINTER :: torsion_kind 91 END TYPE torsion_type 92 93! ************************************************************************************************** 94 TYPE impr_type 95 INTEGER :: a, b, c, d 96 INTEGER :: id_type, itype 97 TYPE(impr_kind_type), POINTER :: impr_kind 98 END TYPE impr_type 99 100! ************************************************************************************************** 101 TYPE opbend_type 102 INTEGER :: a, b, c, d 103 INTEGER :: id_type, itype 104 TYPE(opbend_kind_type), POINTER :: opbend_kind 105 END TYPE opbend_type 106 107! ************************************************************************************************** 108 TYPE restraint_type 109 LOGICAL :: active 110 REAL(KIND=dp) :: k0 111 END TYPE restraint_type 112 113! ************************************************************************************************** 114 TYPE colvar_constraint_type 115 INTEGER :: type_id 116 INTEGER :: inp_seq_num 117 LOGICAL :: use_points 118 REAL(KIND=dp) :: expected_value 119 REAL(KIND=dp) :: expected_value_growth_speed 120 INTEGER, POINTER, DIMENSION(:) :: i_atoms 121 TYPE(restraint_type) :: restraint 122 END TYPE colvar_constraint_type 123 124! ************************************************************************************************** 125 TYPE g3x3_constraint_type 126 INTEGER :: a, b, c 127 REAL(KIND=dp) :: dab, dac, dbc 128 TYPE(restraint_type) :: restraint 129 END TYPE g3x3_constraint_type 130 131! ************************************************************************************************** 132 TYPE g4x6_constraint_type 133 INTEGER :: a, b, c, d 134 REAL(KIND=dp) :: dab, dac, dbc, dad, dbd, dcd 135 TYPE(restraint_type) :: restraint 136 END TYPE g4x6_constraint_type 137 138! ************************************************************************************************** 139 TYPE vsite_constraint_type 140 INTEGER :: a, b, c, d 141 REAL(KIND=dp) :: wbc, wdc 142 TYPE(restraint_type) :: restraint 143 END TYPE vsite_constraint_type 144 145! ************************************************************************************************** 146 TYPE fixd_constraint_type 147 TYPE(restraint_type) :: restraint 148 INTEGER :: fixd, itype 149 REAL(KIND=dp), DIMENSION(3) :: coord 150 END TYPE fixd_constraint_type 151 152! ************************************************************************************************** 153 TYPE local_fixd_constraint_type 154 INTEGER :: ifixd_index, ikind 155 END TYPE local_fixd_constraint_type 156 157! ************************************************************************************************** 158 TYPE molecule_kind_type 159 TYPE(atom_type), DIMENSION(:), POINTER :: atom_list 160 TYPE(bond_kind_type), DIMENSION(:), POINTER :: bond_kind_set 161 TYPE(bond_type), DIMENSION(:), POINTER :: bond_list 162 TYPE(bend_kind_type), DIMENSION(:), POINTER :: bend_kind_set 163 TYPE(bend_type), DIMENSION(:), POINTER :: bend_list 164 TYPE(ub_kind_type), DIMENSION(:), POINTER :: ub_kind_set 165 TYPE(ub_type), DIMENSION(:), POINTER :: ub_list 166 TYPE(torsion_kind_type), DIMENSION(:), POINTER :: torsion_kind_set 167 TYPE(torsion_type), DIMENSION(:), POINTER :: torsion_list 168 TYPE(impr_kind_type), DIMENSION(:), POINTER :: impr_kind_set 169 TYPE(impr_type), DIMENSION(:), POINTER :: impr_list 170 TYPE(opbend_kind_type), DIMENSION(:), POINTER :: opbend_kind_set 171 TYPE(opbend_type), DIMENSION(:), POINTER :: opbend_list 172 TYPE(colvar_constraint_type), DIMENSION(:), POINTER :: colv_list 173 TYPE(g3x3_constraint_type), DIMENSION(:), POINTER :: g3x3_list 174 TYPE(g4x6_constraint_type), DIMENSION(:), POINTER :: g4x6_list 175 TYPE(vsite_constraint_type), DIMENSION(:), POINTER :: vsite_list 176 TYPE(fixd_constraint_type), DIMENSION(:), POINTER :: fixd_list 177 TYPE(shell_type), DIMENSION(:), POINTER :: shell_list 178 CHARACTER(LEN=default_string_length) :: name 179 REAL(KIND=dp) :: charge, & 180 mass 181 INTEGER :: kind_number, & 182 natom, & 183 nbond, & 184 nbend, & 185 nimpr, & 186 nopbend, & 187 ntorsion, & 188 nub, & 189 ng3x3, ng3x3_restraint, & 190 ng4x6, ng4x6_restraint, & 191 nvsite, nvsite_restraint, & 192 nfixd, nfixd_restraint, & 193 nmolecule, nshell 194 TYPE(colvar_counters) :: ncolv 195 INTEGER :: nsgf, nelectron, & 196 nelectron_alpha, & 197 nelectron_beta 198 INTEGER, DIMENSION(:), POINTER :: molecule_list 199 LOGICAL :: molname_generated 200 END TYPE molecule_kind_type 201 202 ! *** Public subroutines *** 203 PUBLIC :: allocate_molecule_kind_set, & 204 deallocate_molecule_kind_set, & 205 get_molecule_kind, & 206 get_molecule_kind_set, & 207 set_molecule_kind, & 208 write_molecule_kind_set, & 209 setup_colvar_counters 210 211 ! *** Public data types *** 212 PUBLIC :: atom_type, & 213 bend_type, & 214 bond_type, & 215 ub_type, & 216 torsion_type, & 217 impr_type, & 218 opbend_type, & 219 colvar_constraint_type, & 220 g3x3_constraint_type, & 221 g4x6_constraint_type, & 222 vsite_constraint_type, & 223 fixd_constraint_type, & 224 local_fixd_constraint_type, & 225 molecule_kind_type, & 226 shell_type 227 228CONTAINS 229 230! ************************************************************************************************** 231!> \brief ... 232!> \param colv_list ... 233!> \param ncolv ... 234! ************************************************************************************************** 235 SUBROUTINE setup_colvar_counters(colv_list, ncolv) 236 TYPE(colvar_constraint_type), DIMENSION(:), & 237 POINTER :: colv_list 238 TYPE(colvar_counters) :: ncolv 239 240 CHARACTER(len=*), PARAMETER :: routineN = 'setup_colvar_counters', & 241 routineP = moduleN//':'//routineN 242 243 INTEGER :: k 244 245 ncolv%ndist = 0 246 ncolv%nangle = 0 247 ncolv%ndfunct = 0 248 ncolv%ntorsion = 0 249 ncolv%ncoord = 0 250 ncolv%nplane_dist = 0 251 ncolv%nplane_angle = 0 252 ncolv%nrot = 0 253 ncolv%nqparm = 0 254 ncolv%nxyz_diag = 0 255 ncolv%nxyz_outerdiag = 0 256 ncolv%nhydronium_shell = 0 257 ncolv%nhydronium_dist = 0 258 ncolv%nacid_hyd_dist = 0 259 ncolv%nacid_hyd_shell = 0 260 ncolv%nreactionpath = 0 261 ncolv%ncombinecvs = 0 262 ncolv%nrestraint = 0 263 ncolv%npopulation = 0 264 ncolv%ngyration = 0 265 266 IF (ASSOCIATED(colv_list)) THEN 267 DO k = 1, SIZE(colv_list) 268 IF (colv_list(k)%restraint%active) ncolv%nrestraint = ncolv%nrestraint + 1 269 SELECT CASE (colv_list(k)%type_id) 270 CASE (angle_colvar_id) 271 ncolv%nangle = ncolv%nangle + 1 272 CASE (coord_colvar_id) 273 ncolv%ncoord = ncolv%ncoord + 1 274 CASE (population_colvar_id) 275 ncolv%npopulation = ncolv%npopulation + 1 276 CASE (gyration_colvar_id) 277 ncolv%ngyration = ncolv%ngyration + 1 278 CASE (rotation_colvar_id) 279 ncolv%nrot = ncolv%nrot + 1 280 CASE (dist_colvar_id) 281 ncolv%ndist = ncolv%ndist + 1 282 CASE (dfunct_colvar_id) 283 ncolv%ndfunct = ncolv%ndfunct + 1 284 CASE (plane_distance_colvar_id) 285 ncolv%nplane_dist = ncolv%nplane_dist + 1 286 CASE (plane_plane_angle_colvar_id) 287 ncolv%nplane_angle = ncolv%nplane_angle + 1 288 CASE (torsion_colvar_id) 289 ncolv%ntorsion = ncolv%ntorsion + 1 290 CASE (qparm_colvar_id) 291 ncolv%nqparm = ncolv%nqparm + 1 292 CASE (xyz_diag_colvar_id) 293 ncolv%nxyz_diag = ncolv%nxyz_diag + 1 294 CASE (xyz_outerdiag_colvar_id) 295 ncolv%nxyz_outerdiag = ncolv%nxyz_outerdiag + 1 296 CASE (hydronium_shell_colvar_id) 297 ncolv%nhydronium_shell = ncolv%nhydronium_shell + 1 298 CASE (hydronium_dist_colvar_id) 299 ncolv%nhydronium_dist = ncolv%nhydronium_dist + 1 300 CASE (acid_hyd_dist_colvar_id) 301 ncolv%nacid_hyd_dist = ncolv%nacid_hyd_dist + 1 302 CASE (acid_hyd_shell_colvar_id) 303 ncolv%nacid_hyd_shell = ncolv%nacid_hyd_shell + 1 304 CASE (reaction_path_colvar_id) 305 ncolv%nreactionpath = ncolv%nreactionpath + 1 306 CASE (combine_colvar_id) 307 ncolv%ncombinecvs = ncolv%ncombinecvs + 1 308 CASE DEFAULT 309 CPABORT("") 310 END SELECT 311 END DO 312 END IF 313 ncolv%ntot = ncolv%ndist + & 314 ncolv%nangle + & 315 ncolv%ntorsion + & 316 ncolv%ncoord + & 317 ncolv%nplane_dist + & 318 ncolv%nplane_angle + & 319 ncolv%ndfunct + & 320 ncolv%nrot + & 321 ncolv%nqparm + & 322 ncolv%nxyz_diag + & 323 ncolv%nxyz_outerdiag + & 324 ncolv%nhydronium_shell + & 325 ncolv%nhydronium_dist + & 326 ncolv%nacid_hyd_dist + & 327 ncolv%nacid_hyd_shell + & 328 ncolv%nreactionpath + & 329 ncolv%ncombinecvs + & 330 ncolv%npopulation + & 331 ncolv%ngyration 332 333 END SUBROUTINE setup_colvar_counters 334 335! ************************************************************************************************** 336!> \brief Allocate and initialize a molecule kind set. 337!> \param molecule_kind_set ... 338!> \param nmolecule_kind ... 339!> \date 22.08.2003 340!> \author MK 341!> \version 1.0 342! ************************************************************************************************** 343 SUBROUTINE allocate_molecule_kind_set(molecule_kind_set, nmolecule_kind) 344 TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set 345 INTEGER, INTENT(IN) :: nmolecule_kind 346 347 CHARACTER(len=*), PARAMETER :: routineN = 'allocate_molecule_kind_set', & 348 routineP = moduleN//':'//routineN 349 350 INTEGER :: imolecule_kind 351 352 IF (ASSOCIATED(molecule_kind_set)) THEN 353 CALL deallocate_molecule_kind_set(molecule_kind_set) 354 END IF 355 356 ALLOCATE (molecule_kind_set(nmolecule_kind)) 357 358 DO imolecule_kind = 1, nmolecule_kind 359 NULLIFY (molecule_kind_set(imolecule_kind)%atom_list) 360 NULLIFY (molecule_kind_set(imolecule_kind)%bond_list) 361 NULLIFY (molecule_kind_set(imolecule_kind)%bend_list) 362 NULLIFY (molecule_kind_set(imolecule_kind)%colv_list) 363 NULLIFY (molecule_kind_set(imolecule_kind)%ub_list) 364 NULLIFY (molecule_kind_set(imolecule_kind)%ub_kind_set) 365 NULLIFY (molecule_kind_set(imolecule_kind)%impr_kind_set) 366 NULLIFY (molecule_kind_set(imolecule_kind)%impr_list) 367 NULLIFY (molecule_kind_set(imolecule_kind)%opbend_kind_set) 368 NULLIFY (molecule_kind_set(imolecule_kind)%opbend_list) 369 NULLIFY (molecule_kind_set(imolecule_kind)%g3x3_list) 370 NULLIFY (molecule_kind_set(imolecule_kind)%g4x6_list) 371 NULLIFY (molecule_kind_set(imolecule_kind)%vsite_list) 372 NULLIFY (molecule_kind_set(imolecule_kind)%fixd_list) 373 NULLIFY (molecule_kind_set(imolecule_kind)%shell_list) 374 NULLIFY (molecule_kind_set(imolecule_kind)%torsion_list) 375 NULLIFY (molecule_kind_set(imolecule_kind)%bond_kind_set) 376 NULLIFY (molecule_kind_set(imolecule_kind)%bend_kind_set) 377 NULLIFY (molecule_kind_set(imolecule_kind)%torsion_kind_set) 378 molecule_kind_set(imolecule_kind)%charge = 0.0_dp 379 molecule_kind_set(imolecule_kind)%mass = 0.0_dp 380 molecule_kind_set(imolecule_kind)%name = "" 381 molecule_kind_set(imolecule_kind)%molname_generated = .FALSE. 382 molecule_kind_set(imolecule_kind)%kind_number = imolecule_kind 383 molecule_kind_set(imolecule_kind)%natom = 0 384 molecule_kind_set(imolecule_kind)%nbend = 0 385 molecule_kind_set(imolecule_kind)%nbond = 0 386 molecule_kind_set(imolecule_kind)%nimpr = 0 387 molecule_kind_set(imolecule_kind)%nopbend = 0 388 molecule_kind_set(imolecule_kind)%nub = 0 389 CALL setup_colvar_counters(molecule_kind_set(imolecule_kind)%colv_list, & 390 molecule_kind_set(imolecule_kind)%ncolv) 391 molecule_kind_set(imolecule_kind)%ng3x3 = 0 392 molecule_kind_set(imolecule_kind)%ng4x6 = 0 393 molecule_kind_set(imolecule_kind)%nvsite = 0 394 molecule_kind_set(imolecule_kind)%nfixd = 0 395 molecule_kind_set(imolecule_kind)%ng3x3_restraint = 0 396 molecule_kind_set(imolecule_kind)%ng4x6_restraint = 0 397 molecule_kind_set(imolecule_kind)%nvsite_restraint = 0 398 molecule_kind_set(imolecule_kind)%nfixd_restraint = 0 399 molecule_kind_set(imolecule_kind)%nmolecule = 0 400 molecule_kind_set(imolecule_kind)%ntorsion = 0 401 molecule_kind_set(imolecule_kind)%nshell = 0 402 NULLIFY (molecule_kind_set(imolecule_kind)%molecule_list) 403 END DO 404 405 END SUBROUTINE allocate_molecule_kind_set 406 407! ************************************************************************************************** 408!> \brief Deallocate a molecule kind set. 409!> \param molecule_kind_set ... 410!> \date 22.08.2003 411!> \author MK 412!> \version 1.0 413! ************************************************************************************************** 414 SUBROUTINE deallocate_molecule_kind_set(molecule_kind_set) 415 416 TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set 417 418 CHARACTER(len=*), PARAMETER :: routineN = 'deallocate_molecule_kind_set', & 419 routineP = moduleN//':'//routineN 420 421 INTEGER :: i, imolecule_kind, j, nmolecule_kind 422 423 IF (ASSOCIATED(molecule_kind_set)) THEN 424 425 nmolecule_kind = SIZE(molecule_kind_set) 426 427 DO imolecule_kind = 1, nmolecule_kind 428 429 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%atom_list)) THEN 430 DEALLOCATE (molecule_kind_set(imolecule_kind)%atom_list) 431 END IF 432 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%bend_kind_set)) THEN 433 DO i = 1, SIZE(molecule_kind_set(imolecule_kind)%bend_kind_set) 434 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%bend_kind_set(i)%legendre%coeffs)) & 435 DEALLOCATE (molecule_kind_set(imolecule_kind)%bend_kind_set(i)%legendre%coeffs) 436 NULLIFY (molecule_kind_set(imolecule_kind)%bend_kind_set(i)%legendre%coeffs) 437 END DO 438 DEALLOCATE (molecule_kind_set(imolecule_kind)%bend_kind_set) 439 END IF 440 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%bend_list)) THEN 441 DEALLOCATE (molecule_kind_set(imolecule_kind)%bend_list) 442 END IF 443 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%ub_list)) THEN 444 DEALLOCATE (molecule_kind_set(imolecule_kind)%ub_list) 445 END IF 446 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%ub_kind_set)) THEN 447 CALL ub_kind_dealloc_ref(molecule_kind_set(imolecule_kind)%ub_kind_set) 448 END IF 449 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%impr_list)) THEN 450 DEALLOCATE (molecule_kind_set(imolecule_kind)%impr_list) 451 END IF 452 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%impr_kind_set)) THEN 453 DO i = 1, SIZE(molecule_kind_set(imolecule_kind)%impr_kind_set) 454 CALL impr_kind_dealloc_ref() !This Subroutine doesn't deallocate anything, maybe needs to be implemented 455 END DO 456 DEALLOCATE (molecule_kind_set(imolecule_kind)%impr_kind_set) 457 END IF 458 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%opbend_list)) THEN 459 DEALLOCATE (molecule_kind_set(imolecule_kind)%opbend_list) 460 END IF 461 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%opbend_kind_set)) THEN 462 DEALLOCATE (molecule_kind_set(imolecule_kind)%opbend_kind_set) 463 END IF 464 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%bond_kind_set)) THEN 465 DEALLOCATE (molecule_kind_set(imolecule_kind)%bond_kind_set) 466 END IF 467 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%bond_list)) THEN 468 DEALLOCATE (molecule_kind_set(imolecule_kind)%bond_list) 469 END IF 470 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%colv_list)) THEN 471 DO j = 1, SIZE(molecule_kind_set(imolecule_kind)%colv_list) 472 DEALLOCATE (molecule_kind_set(imolecule_kind)%colv_list(j)%i_atoms) 473 END DO 474 DEALLOCATE (molecule_kind_set(imolecule_kind)%colv_list) 475 END IF 476 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%g3x3_list)) THEN 477 DEALLOCATE (molecule_kind_set(imolecule_kind)%g3x3_list) 478 END IF 479 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%g4x6_list)) THEN 480 DEALLOCATE (molecule_kind_set(imolecule_kind)%g4x6_list) 481 END IF 482 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%vsite_list)) THEN 483 DEALLOCATE (molecule_kind_set(imolecule_kind)%vsite_list) 484 END IF 485 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%fixd_list)) THEN 486 DEALLOCATE (molecule_kind_set(imolecule_kind)%fixd_list) 487 END IF 488 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%torsion_kind_set)) THEN 489 DO i = 1, SIZE(molecule_kind_set(imolecule_kind)%torsion_kind_set) 490 CALL torsion_kind_dealloc_ref(molecule_kind_set(imolecule_kind)%torsion_kind_set(i)) 491 END DO 492 DEALLOCATE (molecule_kind_set(imolecule_kind)%torsion_kind_set) 493 END IF 494 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%shell_list)) THEN 495 DEALLOCATE (molecule_kind_set(imolecule_kind)%shell_list) 496 END IF 497 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%torsion_list)) THEN 498 DEALLOCATE (molecule_kind_set(imolecule_kind)%torsion_list) 499 END IF 500 IF (ASSOCIATED(molecule_kind_set(imolecule_kind)%molecule_list)) THEN 501 DEALLOCATE (molecule_kind_set(imolecule_kind)%molecule_list) 502 ENDIF 503 END DO 504 505 DEALLOCATE (molecule_kind_set) 506 ELSE 507 CPABORT("The pointer molecule_kind_set is not associated and cannot be deallocated") 508 END IF 509 510 END SUBROUTINE deallocate_molecule_kind_set 511 512! ************************************************************************************************** 513!> \brief Get informations about a molecule kind. 514!> \param molecule_kind ... 515!> \param atom_list ... 516!> \param bond_list ... 517!> \param bend_list ... 518!> \param ub_list ... 519!> \param impr_list ... 520!> \param opbend_list ... 521!> \param colv_list ... 522!> \param fixd_list ... 523!> \param g3x3_list ... 524!> \param g4x6_list ... 525!> \param vsite_list ... 526!> \param torsion_list ... 527!> \param shell_list ... 528!> \param name ... 529!> \param mass ... 530!> \param charge ... 531!> \param kind_number ... 532!> \param natom ... 533!> \param nbend ... 534!> \param nbond ... 535!> \param nub ... 536!> \param nimpr ... 537!> \param nopbend ... 538!> \param nconstraint ... 539!> \param nconstraint_fixd ... 540!> \param nfixd ... 541!> \param ncolv ... 542!> \param ng3x3 ... 543!> \param ng4x6 ... 544!> \param nvsite ... 545!> \param nfixd_restraint ... 546!> \param ng3x3_restraint ... 547!> \param ng4x6_restraint ... 548!> \param nvsite_restraint ... 549!> \param nrestraints ... 550!> \param nmolecule ... 551!> \param nsgf ... 552!> \param nshell ... 553!> \param ntorsion ... 554!> \param molecule_list ... 555!> \param nelectron ... 556!> \param nelectron_alpha ... 557!> \param nelectron_beta ... 558!> \param bond_kind_set ... 559!> \param bend_kind_set ... 560!> \param ub_kind_set ... 561!> \param impr_kind_set ... 562!> \param opbend_kind_set ... 563!> \param torsion_kind_set ... 564!> \param molname_generated ... 565!> \date 27.08.2003 566!> \author MK 567!> \version 1.0 568! ************************************************************************************************** 569 SUBROUTINE get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, & 570 ub_list, impr_list, opbend_list, colv_list, fixd_list, & 571 g3x3_list, g4x6_list, vsite_list, torsion_list, shell_list, & 572 name, mass, charge, kind_number, natom, nbend, nbond, nub, & 573 nimpr, nopbend, nconstraint, nconstraint_fixd, nfixd, ncolv, ng3x3, ng4x6, & 574 nvsite, nfixd_restraint, ng3x3_restraint, ng4x6_restraint, & 575 nvsite_restraint, nrestraints, nmolecule, nsgf, nshell, ntorsion, & 576 molecule_list, nelectron, nelectron_alpha, nelectron_beta, & 577 bond_kind_set, bend_kind_set, & 578 ub_kind_set, impr_kind_set, opbend_kind_set, torsion_kind_set, & 579 molname_generated) 580 581 TYPE(molecule_kind_type), POINTER :: molecule_kind 582 TYPE(atom_type), DIMENSION(:), OPTIONAL, POINTER :: atom_list 583 TYPE(bond_type), DIMENSION(:), OPTIONAL, POINTER :: bond_list 584 TYPE(bend_type), DIMENSION(:), OPTIONAL, POINTER :: bend_list 585 TYPE(ub_type), DIMENSION(:), OPTIONAL, POINTER :: ub_list 586 TYPE(impr_type), DIMENSION(:), OPTIONAL, POINTER :: impr_list 587 TYPE(opbend_type), DIMENSION(:), OPTIONAL, POINTER :: opbend_list 588 TYPE(colvar_constraint_type), DIMENSION(:), & 589 OPTIONAL, POINTER :: colv_list 590 TYPE(fixd_constraint_type), DIMENSION(:), & 591 OPTIONAL, POINTER :: fixd_list 592 TYPE(g3x3_constraint_type), DIMENSION(:), & 593 OPTIONAL, POINTER :: g3x3_list 594 TYPE(g4x6_constraint_type), DIMENSION(:), & 595 OPTIONAL, POINTER :: g4x6_list 596 TYPE(vsite_constraint_type), DIMENSION(:), & 597 OPTIONAL, POINTER :: vsite_list 598 TYPE(torsion_type), DIMENSION(:), OPTIONAL, & 599 POINTER :: torsion_list 600 TYPE(shell_type), DIMENSION(:), OPTIONAL, POINTER :: shell_list 601 CHARACTER(LEN=default_string_length), & 602 INTENT(OUT), OPTIONAL :: name 603 REAL(KIND=dp), OPTIONAL :: mass, charge 604 INTEGER, INTENT(OUT), OPTIONAL :: kind_number, natom, nbend, nbond, nub, & 605 nimpr, nopbend, nconstraint, & 606 nconstraint_fixd, nfixd 607 TYPE(colvar_counters), INTENT(out), OPTIONAL :: ncolv 608 INTEGER, INTENT(OUT), OPTIONAL :: ng3x3, ng4x6, nvsite, nfixd_restraint, ng3x3_restraint, & 609 ng4x6_restraint, nvsite_restraint, nrestraints, nmolecule, nsgf, nshell, ntorsion 610 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: molecule_list 611 INTEGER, INTENT(OUT), OPTIONAL :: nelectron, nelectron_alpha, & 612 nelectron_beta 613 TYPE(bond_kind_type), DIMENSION(:), OPTIONAL, & 614 POINTER :: bond_kind_set 615 TYPE(bend_kind_type), DIMENSION(:), OPTIONAL, & 616 POINTER :: bend_kind_set 617 TYPE(ub_kind_type), DIMENSION(:), OPTIONAL, & 618 POINTER :: ub_kind_set 619 TYPE(impr_kind_type), DIMENSION(:), OPTIONAL, & 620 POINTER :: impr_kind_set 621 TYPE(opbend_kind_type), DIMENSION(:), OPTIONAL, & 622 POINTER :: opbend_kind_set 623 TYPE(torsion_kind_type), DIMENSION(:), OPTIONAL, & 624 POINTER :: torsion_kind_set 625 LOGICAL, INTENT(OUT), OPTIONAL :: molname_generated 626 627 CHARACTER(len=*), PARAMETER :: routineN = 'get_molecule_kind', & 628 routineP = moduleN//':'//routineN 629 630 INTEGER :: i 631 632 IF (ASSOCIATED(molecule_kind)) THEN 633 634 IF (PRESENT(atom_list)) atom_list => molecule_kind%atom_list 635 IF (PRESENT(bend_list)) bend_list => molecule_kind%bend_list 636 IF (PRESENT(bond_list)) bond_list => molecule_kind%bond_list 637 IF (PRESENT(impr_list)) impr_list => molecule_kind%impr_list 638 IF (PRESENT(opbend_list)) opbend_list => molecule_kind%opbend_list 639 IF (PRESENT(ub_list)) ub_list => molecule_kind%ub_list 640 IF (PRESENT(bond_kind_set)) bond_kind_set => molecule_kind%bond_kind_set 641 IF (PRESENT(bend_kind_set)) bend_kind_set => molecule_kind%bend_kind_set 642 IF (PRESENT(ub_kind_set)) ub_kind_set => molecule_kind%ub_kind_set 643 IF (PRESENT(impr_kind_set)) impr_kind_set => molecule_kind%impr_kind_set 644 IF (PRESENT(opbend_kind_set)) opbend_kind_set => molecule_kind%opbend_kind_set 645 IF (PRESENT(torsion_kind_set)) torsion_kind_set => molecule_kind%torsion_kind_set 646 IF (PRESENT(colv_list)) colv_list => molecule_kind%colv_list 647 IF (PRESENT(g3x3_list)) g3x3_list => molecule_kind%g3x3_list 648 IF (PRESENT(g4x6_list)) g4x6_list => molecule_kind%g4x6_list 649 IF (PRESENT(vsite_list)) vsite_list => molecule_kind%vsite_list 650 IF (PRESENT(fixd_list)) fixd_list => molecule_kind%fixd_list 651 IF (PRESENT(torsion_list)) torsion_list => molecule_kind%torsion_list 652 IF (PRESENT(shell_list)) shell_list => molecule_kind%shell_list 653 IF (PRESENT(name)) name = molecule_kind%name 654 IF (PRESENT(molname_generated)) molname_generated = molecule_kind%molname_generated 655 IF (PRESENT(mass)) mass = molecule_kind%mass 656 IF (PRESENT(charge)) charge = molecule_kind%charge 657 IF (PRESENT(kind_number)) kind_number = molecule_kind%kind_number 658 IF (PRESENT(natom)) natom = molecule_kind%natom 659 IF (PRESENT(nbend)) nbend = molecule_kind%nbend 660 IF (PRESENT(nbond)) nbond = molecule_kind%nbond 661 IF (PRESENT(nub)) nub = molecule_kind%nub 662 IF (PRESENT(nimpr)) nimpr = molecule_kind%nimpr 663 IF (PRESENT(nopbend)) nopbend = molecule_kind%nopbend 664 IF (PRESENT(nconstraint)) nconstraint = (molecule_kind%ncolv%ntot - molecule_kind%ncolv%nrestraint) + & 665 3*(molecule_kind%ng3x3 - molecule_kind%ng3x3_restraint) + & 666 6*(molecule_kind%ng4x6 - molecule_kind%ng4x6_restraint) + & 667 3*(molecule_kind%nvsite - molecule_kind%nvsite_restraint) 668 IF (PRESENT(ncolv)) ncolv = molecule_kind%ncolv 669 IF (PRESENT(ng3x3)) ng3x3 = molecule_kind%ng3x3 670 IF (PRESENT(ng4x6)) ng4x6 = molecule_kind%ng4x6 671 IF (PRESENT(nvsite)) nvsite = molecule_kind%nvsite 672 ! Number of atoms that have one or more components fixed 673 IF (PRESENT(nfixd)) nfixd = molecule_kind%nfixd 674 ! Number of degrees of freedom fixed 675 IF (PRESENT(nconstraint_fixd)) THEN 676 nconstraint_fixd = 0 677 IF (molecule_kind%nfixd /= 0) THEN 678 DO i = 1, SIZE(molecule_kind%fixd_list) 679 IF (molecule_kind%fixd_list(i)%restraint%active) CYCLE 680 SELECT CASE (molecule_kind%fixd_list(i)%itype) 681 CASE (use_perd_x, use_perd_y, use_perd_z) 682 nconstraint_fixd = nconstraint_fixd + 1 683 CASE (use_perd_xy, use_perd_xz, use_perd_yz) 684 nconstraint_fixd = nconstraint_fixd + 2 685 CASE (use_perd_xyz) 686 nconstraint_fixd = nconstraint_fixd + 3 687 END SELECT 688 END DO 689 END IF 690 END IF 691 IF (PRESENT(ng3x3_restraint)) ng3x3_restraint = molecule_kind%ng3x3_restraint 692 IF (PRESENT(ng4x6_restraint)) ng4x6_restraint = molecule_kind%ng4x6_restraint 693 IF (PRESENT(nvsite_restraint)) nvsite_restraint = molecule_kind%nvsite_restraint 694 IF (PRESENT(nfixd_restraint)) nfixd_restraint = molecule_kind%nfixd_restraint 695 IF (PRESENT(nrestraints)) nrestraints = molecule_kind%ncolv%nrestraint + & 696 molecule_kind%ng3x3_restraint + & 697 molecule_kind%ng4x6_restraint + & 698 molecule_kind%nvsite_restraint 699 IF (PRESENT(nmolecule)) nmolecule = molecule_kind%nmolecule 700 IF (PRESENT(nshell)) nshell = molecule_kind%nshell 701 IF (PRESENT(ntorsion)) ntorsion = molecule_kind%ntorsion 702 IF (PRESENT(nsgf)) nsgf = molecule_kind%nsgf 703 IF (PRESENT(nelectron)) nelectron = molecule_kind%nelectron 704 IF (PRESENT(nelectron_alpha)) nelectron_alpha = molecule_kind%nelectron_beta 705 IF (PRESENT(nelectron_beta)) nelectron_beta = molecule_kind%nelectron_alpha 706 IF (PRESENT(molecule_list)) molecule_list => molecule_kind%molecule_list 707 708 ELSE 709 710 CPABORT("The pointer molecule_kind is not associated") 711 712 END IF 713 714 END SUBROUTINE get_molecule_kind 715 716! ************************************************************************************************** 717!> \brief Get informations about a molecule kind set. 718!> \param molecule_kind_set ... 719!> \param maxatom ... 720!> \param natom ... 721!> \param nbond ... 722!> \param nbend ... 723!> \param nub ... 724!> \param ntorsion ... 725!> \param nimpr ... 726!> \param nopbend ... 727!> \param nconstraint ... 728!> \param nconstraint_fixd ... 729!> \param nmolecule ... 730!> \param nrestraints ... 731!> \date 27.08.2003 732!> \author MK 733!> \version 1.0 734! ************************************************************************************************** 735 SUBROUTINE get_molecule_kind_set(molecule_kind_set, maxatom, natom, & 736 nbond, nbend, nub, ntorsion, nimpr, nopbend, & 737 nconstraint, nconstraint_fixd, nmolecule, & 738 nrestraints) 739 740 TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set 741 INTEGER, INTENT(OUT), OPTIONAL :: maxatom, natom, nbond, nbend, nub, & 742 ntorsion, nimpr, nopbend, nconstraint, & 743 nconstraint_fixd, nmolecule, & 744 nrestraints 745 746 CHARACTER(len=*), PARAMETER :: routineN = 'get_molecule_kind_set', & 747 routineP = moduleN//':'//routineN 748 749 INTEGER :: ibend, ibond, iimpr, imolecule_kind, iopbend, itorsion, iub, na, nc, nc_fixd, & 750 nfixd_restraint, nm, nmolecule_kind, nrestraints_tot 751 TYPE(molecule_kind_type), POINTER :: molecule_kind 752 753 IF (ASSOCIATED(molecule_kind_set)) THEN 754 755 IF (PRESENT(maxatom)) maxatom = 0 756 IF (PRESENT(natom)) natom = 0 757 IF (PRESENT(nbond)) nbond = 0 758 IF (PRESENT(nbend)) nbend = 0 759 IF (PRESENT(nub)) nub = 0 760 IF (PRESENT(ntorsion)) ntorsion = 0 761 IF (PRESENT(nimpr)) nimpr = 0 762 IF (PRESENT(nopbend)) nopbend = 0 763 IF (PRESENT(nconstraint)) nconstraint = 0 764 IF (PRESENT(nconstraint_fixd)) nconstraint_fixd = 0 765 IF (PRESENT(nrestraints)) nrestraints = 0 766 IF (PRESENT(nmolecule)) nmolecule = 0 767 768 nmolecule_kind = SIZE(molecule_kind_set) 769 770 DO imolecule_kind = 1, nmolecule_kind 771 772 molecule_kind => molecule_kind_set(imolecule_kind) 773 774 CALL get_molecule_kind(molecule_kind=molecule_kind, & 775 natom=na, & 776 nbond=ibond, & 777 nbend=ibend, & 778 nub=iub, & 779 ntorsion=itorsion, & 780 nimpr=iimpr, & 781 nopbend=iopbend, & 782 nconstraint=nc, & 783 nconstraint_fixd=nc_fixd, & 784 nfixd_restraint=nfixd_restraint, & 785 nrestraints=nrestraints_tot, & 786 nmolecule=nm) 787 IF (PRESENT(maxatom)) maxatom = MAX(maxatom, na) 788 IF (PRESENT(natom)) natom = natom + na*nm 789 IF (PRESENT(nbond)) nbond = nbond + ibond*nm 790 IF (PRESENT(nbend)) nbend = nbend + ibend*nm 791 IF (PRESENT(nub)) nub = nub + iub*nm 792 IF (PRESENT(ntorsion)) ntorsion = ntorsion + itorsion*nm 793 IF (PRESENT(nimpr)) nimpr = nimpr + iimpr*nm 794 IF (PRESENT(nopbend)) nopbend = nopbend + iopbend*nm 795 IF (PRESENT(nconstraint)) nconstraint = nconstraint + nc*nm + nc_fixd 796 IF (PRESENT(nconstraint_fixd)) nconstraint_fixd = nconstraint_fixd + nc_fixd 797 IF (PRESENT(nmolecule)) nmolecule = nmolecule + nm 798 IF (PRESENT(nrestraints)) nrestraints = nrestraints + nm*nrestraints_tot + nfixd_restraint 799 800 END DO 801 802 ELSE 803 804 CPABORT("The pointer molecule_kind_set is not associated") 805 806 END IF 807 808 END SUBROUTINE get_molecule_kind_set 809 810! ************************************************************************************************** 811!> \brief Set the components of a molecule kind. 812!> \param molecule_kind ... 813!> \param name ... 814!> \param mass ... 815!> \param charge ... 816!> \param kind_number ... 817!> \param molecule_list ... 818!> \param atom_list ... 819!> \param nbond ... 820!> \param bond_list ... 821!> \param nbend ... 822!> \param bend_list ... 823!> \param nub ... 824!> \param ub_list ... 825!> \param nimpr ... 826!> \param impr_list ... 827!> \param nopbend ... 828!> \param opbend_list ... 829!> \param ntorsion ... 830!> \param torsion_list ... 831!> \param fixd_list ... 832!> \param ncolv ... 833!> \param colv_list ... 834!> \param ng3x3 ... 835!> \param g3x3_list ... 836!> \param ng4x6 ... 837!> \param nfixd ... 838!> \param g4x6_list ... 839!> \param nvsite ... 840!> \param vsite_list ... 841!> \param ng3x3_restraint ... 842!> \param ng4x6_restraint ... 843!> \param nfixd_restraint ... 844!> \param nshell ... 845!> \param shell_list ... 846!> \param nvsite_restraint ... 847!> \param bond_kind_set ... 848!> \param bend_kind_set ... 849!> \param ub_kind_set ... 850!> \param torsion_kind_set ... 851!> \param impr_kind_set ... 852!> \param opbend_kind_set ... 853!> \param nelectron ... 854!> \param nsgf ... 855!> \param molname_generated ... 856!> \date 27.08.2003 857!> \author MK 858!> \version 1.0 859! ************************************************************************************************** 860 SUBROUTINE set_molecule_kind(molecule_kind, name, mass, charge, kind_number, & 861 molecule_list, atom_list, nbond, bond_list, & 862 nbend, bend_list, nub, ub_list, nimpr, impr_list, & 863 nopbend, opbend_list, ntorsion, & 864 torsion_list, fixd_list, ncolv, colv_list, ng3x3, & 865 g3x3_list, ng4x6, nfixd, g4x6_list, nvsite, & 866 vsite_list, ng3x3_restraint, ng4x6_restraint, & 867 nfixd_restraint, nshell, shell_list, & 868 nvsite_restraint, bond_kind_set, bend_kind_set, & 869 ub_kind_set, torsion_kind_set, impr_kind_set, & 870 opbend_kind_set, nelectron, nsgf, & 871 molname_generated) 872 873 TYPE(molecule_kind_type), POINTER :: molecule_kind 874 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name 875 REAL(KIND=dp), OPTIONAL :: mass, charge 876 INTEGER, INTENT(IN), OPTIONAL :: kind_number 877 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: molecule_list 878 TYPE(atom_type), DIMENSION(:), OPTIONAL, POINTER :: atom_list 879 INTEGER, INTENT(IN), OPTIONAL :: nbond 880 TYPE(bond_type), DIMENSION(:), OPTIONAL, POINTER :: bond_list 881 INTEGER, INTENT(IN), OPTIONAL :: nbend 882 TYPE(bend_type), DIMENSION(:), OPTIONAL, POINTER :: bend_list 883 INTEGER, INTENT(IN), OPTIONAL :: nub 884 TYPE(ub_type), DIMENSION(:), OPTIONAL, POINTER :: ub_list 885 INTEGER, INTENT(IN), OPTIONAL :: nimpr 886 TYPE(impr_type), DIMENSION(:), OPTIONAL, POINTER :: impr_list 887 INTEGER, INTENT(IN), OPTIONAL :: nopbend 888 TYPE(opbend_type), DIMENSION(:), OPTIONAL, POINTER :: opbend_list 889 INTEGER, INTENT(IN), OPTIONAL :: ntorsion 890 TYPE(torsion_type), DIMENSION(:), OPTIONAL, & 891 POINTER :: torsion_list 892 TYPE(fixd_constraint_type), DIMENSION(:), & 893 OPTIONAL, POINTER :: fixd_list 894 TYPE(colvar_counters), INTENT(IN), OPTIONAL :: ncolv 895 TYPE(colvar_constraint_type), DIMENSION(:), & 896 OPTIONAL, POINTER :: colv_list 897 INTEGER, INTENT(IN), OPTIONAL :: ng3x3 898 TYPE(g3x3_constraint_type), DIMENSION(:), & 899 OPTIONAL, POINTER :: g3x3_list 900 INTEGER, INTENT(IN), OPTIONAL :: ng4x6, nfixd 901 TYPE(g4x6_constraint_type), DIMENSION(:), & 902 OPTIONAL, POINTER :: g4x6_list 903 INTEGER, INTENT(IN), OPTIONAL :: nvsite 904 TYPE(vsite_constraint_type), DIMENSION(:), & 905 OPTIONAL, POINTER :: vsite_list 906 INTEGER, INTENT(IN), OPTIONAL :: ng3x3_restraint, ng4x6_restraint, & 907 nfixd_restraint, nshell 908 TYPE(shell_type), DIMENSION(:), OPTIONAL, POINTER :: shell_list 909 INTEGER, INTENT(IN), OPTIONAL :: nvsite_restraint 910 TYPE(bond_kind_type), DIMENSION(:), OPTIONAL, & 911 POINTER :: bond_kind_set 912 TYPE(bend_kind_type), DIMENSION(:), OPTIONAL, & 913 POINTER :: bend_kind_set 914 TYPE(ub_kind_type), DIMENSION(:), OPTIONAL, & 915 POINTER :: ub_kind_set 916 TYPE(torsion_kind_type), DIMENSION(:), OPTIONAL, & 917 POINTER :: torsion_kind_set 918 TYPE(impr_kind_type), DIMENSION(:), OPTIONAL, & 919 POINTER :: impr_kind_set 920 TYPE(opbend_kind_type), DIMENSION(:), OPTIONAL, & 921 POINTER :: opbend_kind_set 922 INTEGER, INTENT(IN), OPTIONAL :: nelectron, nsgf 923 LOGICAL, INTENT(IN), OPTIONAL :: molname_generated 924 925 CHARACTER(len=*), PARAMETER :: routineN = 'set_molecule_kind', & 926 routineP = moduleN//':'//routineN 927 928 INTEGER :: n 929 930 IF (ASSOCIATED(molecule_kind)) THEN 931 932 IF (PRESENT(atom_list)) THEN 933 n = SIZE(atom_list) 934 molecule_kind%natom = n 935 molecule_kind%atom_list => atom_list 936 END IF 937 IF (PRESENT(molname_generated)) molecule_kind%molname_generated = molname_generated 938 IF (PRESENT(name)) molecule_kind%name = name 939 IF (PRESENT(mass)) molecule_kind%mass = mass 940 IF (PRESENT(charge)) molecule_kind%charge = charge 941 IF (PRESENT(kind_number)) molecule_kind%kind_number = kind_number 942 IF (PRESENT(nbond)) molecule_kind%nbond = nbond 943 IF (PRESENT(bond_list)) molecule_kind%bond_list => bond_list 944 IF (PRESENT(nbend)) molecule_kind%nbend = nbend 945 IF (PRESENT(nelectron)) molecule_kind%nelectron = nelectron 946 IF (PRESENT(nsgf)) molecule_kind%nsgf = nsgf 947 IF (PRESENT(bend_list)) molecule_kind%bend_list => bend_list 948 IF (PRESENT(nub)) molecule_kind%nub = nub 949 IF (PRESENT(ub_list)) molecule_kind%ub_list => ub_list 950 IF (PRESENT(ntorsion)) molecule_kind%ntorsion = ntorsion 951 IF (PRESENT(torsion_list)) molecule_kind%torsion_list => torsion_list 952 IF (PRESENT(nimpr)) molecule_kind%nimpr = nimpr 953 IF (PRESENT(impr_list)) molecule_kind%impr_list => impr_list 954 IF (PRESENT(nopbend)) molecule_kind%nopbend = nopbend 955 IF (PRESENT(opbend_list)) molecule_kind%opbend_list => opbend_list 956 IF (PRESENT(ncolv)) molecule_kind%ncolv = ncolv 957 IF (PRESENT(colv_list)) molecule_kind%colv_list => colv_list 958 IF (PRESENT(ng3x3)) molecule_kind%ng3x3 = ng3x3 959 IF (PRESENT(g3x3_list)) molecule_kind%g3x3_list => g3x3_list 960 IF (PRESENT(ng4x6)) molecule_kind%ng4x6 = ng4x6 961 IF (PRESENT(nvsite)) molecule_kind%nvsite = nvsite 962 IF (PRESENT(nfixd)) molecule_kind%nfixd = nfixd 963 IF (PRESENT(nfixd_restraint)) molecule_kind%nfixd_restraint = nfixd_restraint 964 IF (PRESENT(ng3x3_restraint)) molecule_kind%ng3x3_restraint = ng3x3_restraint 965 IF (PRESENT(ng4x6_restraint)) molecule_kind%ng4x6_restraint = ng4x6_restraint 966 IF (PRESENT(nvsite_restraint)) molecule_kind%nvsite_restraint = nvsite_restraint 967 IF (PRESENT(g4x6_list)) molecule_kind%g4x6_list => g4x6_list 968 IF (PRESENT(vsite_list)) molecule_kind%vsite_list => vsite_list 969 IF (PRESENT(fixd_list)) molecule_kind%fixd_list => fixd_list 970 IF (PRESENT(bond_kind_set)) molecule_kind%bond_kind_set => bond_kind_set 971 IF (PRESENT(bend_kind_set)) molecule_kind%bend_kind_set => bend_kind_set 972 IF (PRESENT(ub_kind_set)) molecule_kind%ub_kind_set => ub_kind_set 973 IF (PRESENT(torsion_kind_set)) molecule_kind%torsion_kind_set => torsion_kind_set 974 IF (PRESENT(impr_kind_set)) molecule_kind%impr_kind_set => impr_kind_set 975 IF (PRESENT(opbend_kind_set)) molecule_kind%opbend_kind_set => opbend_kind_set 976 IF (PRESENT(nshell)) molecule_kind%nshell = nshell 977 IF (PRESENT(shell_list)) molecule_kind%shell_list => shell_list 978 IF (PRESENT(molecule_list)) THEN 979 n = SIZE(molecule_list) 980 molecule_kind%nmolecule = n 981 molecule_kind%molecule_list => molecule_list 982 END IF 983 984 ELSE 985 986 CPABORT("The pointer molecule_kind is not associated") 987 988 END IF 989 990 END SUBROUTINE set_molecule_kind 991 992! ************************************************************************************************** 993!> \brief Write a molecule kind data set to the output unit. 994!> \param molecule_kind ... 995!> \param output_unit ... 996!> \date 24.09.2003 997!> \author MK 998!> \version 1.0 999! ************************************************************************************************** 1000 SUBROUTINE write_molecule_kind(molecule_kind, output_unit) 1001 TYPE(molecule_kind_type), POINTER :: molecule_kind 1002 INTEGER, INTENT(in) :: output_unit 1003 1004 CHARACTER(len=*), PARAMETER :: routineN = 'write_molecule_kind', & 1005 routineP = moduleN//':'//routineN 1006 1007 CHARACTER(LEN=default_string_length) :: name 1008 INTEGER :: iatom, imolecule, natom, nmolecule 1009 TYPE(atomic_kind_type), POINTER :: atomic_kind 1010 1011 IF (output_unit > 0) THEN 1012 IF (ASSOCIATED(molecule_kind)) THEN 1013 natom = SIZE(molecule_kind%atom_list) 1014 nmolecule = SIZE(molecule_kind%molecule_list) 1015 1016 IF (natom == 1) THEN 1017 atomic_kind => molecule_kind%atom_list(1)%atomic_kind 1018 CALL get_atomic_kind(atomic_kind=atomic_kind, name=name) 1019 WRITE (UNIT=output_unit, FMT="(/,T2,I5,A,T36,A,A,T64,A)") & 1020 molecule_kind%kind_number, & 1021 ". Molecule kind: "//TRIM(molecule_kind%name), & 1022 "Atomic kind name: ", TRIM(name) 1023 WRITE (UNIT=output_unit, FMT="(T9,A,L1,T55,A,T75,I6)") & 1024 "Automatic name: ", molecule_kind%molname_generated, & 1025 "Number of molecules:", nmolecule 1026 ELSE 1027 WRITE (UNIT=output_unit, FMT="(/,T2,I5,A,T50,A,T75,I6,/,T22,A)") & 1028 molecule_kind%kind_number, & 1029 ". Molecule kind: "//TRIM(molecule_kind%name), & 1030 "Number of atoms: ", natom, & 1031 "Atom Atomic kind name" 1032 DO iatom = 1, natom 1033 atomic_kind => molecule_kind%atom_list(iatom)%atomic_kind 1034 CALL get_atomic_kind(atomic_kind=atomic_kind, name=name) 1035 WRITE (UNIT=output_unit, FMT="(T20,I6,(7X,A18))") & 1036 iatom, TRIM(name) 1037 END DO 1038 WRITE (UNIT=output_unit, FMT="(/,T9,A,L1)") & 1039 "The name was automatically generated: ", & 1040 molecule_kind%molname_generated 1041 WRITE (UNIT=output_unit, FMT="(T9,A,I6,/,T9,A,(T30,5I10))") & 1042 "Number of molecules: ", nmolecule, "Molecule list:", & 1043 (molecule_kind%molecule_list(imolecule), imolecule=1, nmolecule) 1044 IF (molecule_kind%nbond > 0) & 1045 WRITE (UNIT=output_unit, FMT="(1X,A30,I6)") & 1046 "Number of bonds: ", molecule_kind%nbond 1047 IF (molecule_kind%nbend > 0) & 1048 WRITE (UNIT=output_unit, FMT="(1X,A30,I6)") & 1049 "Number of bends: ", molecule_kind%nbend 1050 IF (molecule_kind%nub > 0) & 1051 WRITE (UNIT=output_unit, FMT="(1X,A30,I6)") & 1052 "Number of Urey-Bradley:", molecule_kind%nub 1053 IF (molecule_kind%ntorsion > 0) & 1054 WRITE (UNIT=output_unit, FMT="(1X,A30,I6)") & 1055 "Number of torsions: ", molecule_kind%ntorsion 1056 IF (molecule_kind%nimpr > 0) & 1057 WRITE (UNIT=output_unit, FMT="(1X,A30,I6)") & 1058 "Number of improper: ", molecule_kind%nimpr 1059 IF (molecule_kind%nopbend > 0) & 1060 WRITE (UNIT=output_unit, FMT="(1X,A30,I6)") & 1061 "Number of out opbends: ", molecule_kind%nopbend 1062 END IF 1063 1064 ELSE 1065 CPABORT("") 1066 END IF 1067 1068 END IF 1069 END SUBROUTINE write_molecule_kind 1070 1071! ************************************************************************************************** 1072!> \brief Write a moleculeatomic kind set data set to the output unit. 1073!> \param molecule_kind_set ... 1074!> \param subsys_section ... 1075!> \date 24.09.2003 1076!> \author MK 1077!> \version 1.0 1078! ************************************************************************************************** 1079 SUBROUTINE write_molecule_kind_set(molecule_kind_set, subsys_section) 1080 TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set 1081 TYPE(section_vals_type), POINTER :: subsys_section 1082 1083 CHARACTER(len=*), PARAMETER :: routineN = 'write_molecule_kind_set', & 1084 routineP = moduleN//':'//routineN 1085 1086 INTEGER :: handle, imolecule_kind, natom, nbend, & 1087 nbond, nimpr, nmolecule, & 1088 nmolecule_kind, nopbend, ntors, & 1089 ntotal, nub, output_unit 1090 LOGICAL :: all_single_atoms 1091 TYPE(cp_logger_type), POINTER :: logger 1092 TYPE(molecule_kind_type), POINTER :: molecule_kind 1093 1094 CALL timeset(routineN, handle) 1095 1096 NULLIFY (logger) 1097 logger => cp_get_default_logger() 1098 output_unit = cp_print_key_unit_nr(logger, subsys_section, & 1099 "PRINT%MOLECULES", extension=".Log") 1100 IF (output_unit > 0) THEN 1101 IF (ASSOCIATED(molecule_kind_set)) THEN 1102 WRITE (UNIT=output_unit, FMT="(/,/,T2,A)") "MOLECULE KIND INFORMATION" 1103 1104 nmolecule_kind = SIZE(molecule_kind_set) 1105 1106 all_single_atoms = .TRUE. 1107 DO imolecule_kind = 1, nmolecule_kind 1108 natom = SIZE(molecule_kind_set(imolecule_kind)%atom_list) 1109 nmolecule = SIZE(molecule_kind_set(imolecule_kind)%molecule_list) 1110 IF (natom*nmolecule > 1) all_single_atoms = .FALSE. 1111 ENDDO 1112 1113 IF (all_single_atoms) THEN 1114 WRITE (UNIT=output_unit, FMT="(/,/,T2,A)") & 1115 "All atoms are their own molecule, skipping detailed information" 1116 ELSE 1117 DO imolecule_kind = 1, nmolecule_kind 1118 molecule_kind => molecule_kind_set(imolecule_kind) 1119 CALL write_molecule_kind(molecule_kind, output_unit) 1120 END DO 1121 ENDIF 1122 1123 CALL get_molecule_kind_set(molecule_kind_set=molecule_kind_set, & 1124 nbond=nbond, & 1125 nbend=nbend, & 1126 nub=nub, & 1127 ntorsion=ntors, & 1128 nimpr=nimpr, & 1129 nopbend=nopbend) 1130 ntotal = nbond + nbend + nub + ntors + nimpr + nopbend 1131 IF (ntotal > 0) THEN 1132 WRITE (UNIT=output_unit, FMT="(/,/,T2,A,T45,A30,I6)") & 1133 "MOLECULE KIND SET INFORMATION", & 1134 "Total Number of bonds: ", nbond 1135 WRITE (UNIT=output_unit, FMT="(T45,A30,I6)") & 1136 "Total Number of bends: ", nbend 1137 WRITE (UNIT=output_unit, FMT="(T45,A30,I6)") & 1138 "Total Number of Urey-Bradley:", nub 1139 WRITE (UNIT=output_unit, FMT="(T45,A30,I6)") & 1140 "Total Number of torsions: ", ntors 1141 WRITE (UNIT=output_unit, FMT="(T45,A30,I6)") & 1142 "Total Number of improper: ", nimpr 1143 WRITE (UNIT=output_unit, FMT="(T45,A30,I6)") & 1144 "Total Number of opbends: ", nopbend 1145 END IF 1146 ELSE 1147 CPABORT("") 1148 END IF 1149 1150 END IF 1151 CALL cp_print_key_finished_output(output_unit, logger, subsys_section, & 1152 "PRINT%MOLECULES") 1153 1154 CALL timestop(handle) 1155 1156 END SUBROUTINE write_molecule_kind_set 1157 1158END MODULE molecule_kind_types 1159