(git:916bf6e)
Loading...
Searching...
No Matches
topology_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \par History
10!> JGH (30.11.2001) : new entries in setup_parameters_type
11!> change name from input_file_name to coord_...
12!> added topology file
13!> added atom_names
14!> Teodoro Laino [tlaino] 12.2008 - Preparing for VIRTUAL SITE constraints
15!> (patch by Marcel Baer)
16!> \author CJM & JGH
17! **************************************************************************************************
19 USE cell_types, ONLY: cell_release,&
21 USE colvar_types, ONLY: colvar_p_type,&
27 USE kinds, ONLY: default_path_length,&
29 dp
30#include "./base/base_uses.f90"
31
32 IMPLICIT NONE
33
34! **************************************************************************************************
36 INTEGER, DIMENSION(:), POINTER :: id_molname => null(), &
37 id_resname => null(), &
38 id_atmname => null(), &
39 id_atom_names => null(), &
40 id_element => null()
41 INTEGER, POINTER :: resid(:) => null()
42 REAL(kind=dp), DIMENSION(:, :), POINTER :: r => null()
43 INTEGER, POINTER :: map_mol_typ(:) => null()
44 INTEGER, POINTER :: map_mol_num(:) => null()
45 INTEGER, POINTER :: map_mol_res(:) => null()
46 REAL(kind=dp), POINTER :: atm_charge(:) => null()
47 REAL(kind=dp), POINTER :: atm_mass(:) => null()
48 REAL(kind=dp), POINTER :: occup(:) => null()
49 REAL(kind=dp), POINTER :: beta(:) => null()
50 END TYPE atom_info_type
51
52! **************************************************************************************************
54 INTEGER, POINTER :: bond_a(:) => null(), bond_b(:) => null(), bond_type(:) => null()
55 INTEGER, POINTER :: ub_a(:) => null(), ub_b(:) => null(), ub_c(:) => null()
56 INTEGER, POINTER :: theta_a(:) => null(), theta_b(:) => null(), theta_c(:) => null(), theta_type(:) => null()
57 INTEGER, POINTER :: phi_a(:) => null(), phi_b(:) => null(), phi_c(:) => null(), phi_d(:) => null(), phi_type(:) => null()
58 INTEGER, POINTER :: impr_a(:) => null(), impr_b(:) => null(), impr_c(:) => null(), &
59 impr_d(:) => null(), impr_type(:) => null()
60 INTEGER, POINTER :: onfo_a(:) => null(), onfo_b(:) => null()
61 INTEGER, POINTER :: c_bond_a(:) => null(), c_bond_b(:) => null(), c_bond_type(:) => null()
63
64! **************************************************************************************************
66 ! Bonds involving Hydrogens
67 LOGICAL :: hbonds_restraint = .false. ! Restraints control
68 REAL(kind=dp) :: hbonds_k0 = -1.0_dp ! Restraints control
69 ! Fixed Atoms
70 INTEGER :: nfixed_atoms = -1
71 INTEGER, POINTER :: fixed_atoms(:) => null(), fixed_type(:) => null(), fixed_mol_type(:) => null()
72 LOGICAL, POINTER :: fixed_restraint(:) => null() ! Restraints control
73 REAL(kind=dp), POINTER :: fixed_k0(:) => null() ! Restraints control
74 ! Freeze QM or MM
75 INTEGER :: freeze_qm = -1, freeze_mm = -1, freeze_qm_type = -1, freeze_mm_type = -1
76 LOGICAL :: fixed_mm_restraint = .false., fixed_qm_restraint = .false. ! Restraints control
77 REAL(kind=dp) :: fixed_mm_k0 = -1.0_dp, fixed_qm_k0 = -1.0_dp ! Restraints control
78 ! Freeze with molnames
79 LOGICAL, POINTER :: fixed_mol_restraint(:) => null() ! Restraints control
80 REAL(kind=dp), POINTER :: fixed_mol_k0(:) => null() ! Restraints control
81 CHARACTER(LEN=default_string_length), POINTER :: fixed_molnames(:) => null()
82 LOGICAL, POINTER, DIMENSION(:) :: fixed_exclude_qm => null(), fixed_exclude_mm => null()
83 ! Collective constraints
84 INTEGER :: nconst_colv = -1
85 INTEGER, POINTER :: const_colv_mol(:) => null()
86 CHARACTER(LEN=default_string_length), POINTER :: const_colv_molname(:) => null()
87 REAL(kind=dp), POINTER :: const_colv_target(:) => null()
88 REAL(kind=dp), POINTER :: const_colv_target_growth(:) => null()
89 TYPE(colvar_p_type), POINTER, DIMENSION(:) :: colvar_set => null()
90 LOGICAL, POINTER :: colv_intermolecular(:) => null()
91 LOGICAL, POINTER :: colv_restraint(:) => null() ! Restraints control
92 REAL(kind=dp), POINTER :: colv_k0(:) => null() ! Restraints control
93 LOGICAL, POINTER, DIMENSION(:) :: colv_exclude_qm => null(), colv_exclude_mm => null()
94 ! G3x3
95 INTEGER :: nconst_g33 = -1
96 INTEGER, POINTER :: const_g33_mol(:) => null()
97 CHARACTER(LEN=default_string_length), POINTER :: const_g33_molname(:) => null()
98 INTEGER, POINTER :: const_g33_a(:) => null()
99 INTEGER, POINTER :: const_g33_b(:) => null()
100 INTEGER, POINTER :: const_g33_c(:) => null()
101 REAL(kind=dp), POINTER :: const_g33_dab(:) => null()
102 REAL(kind=dp), POINTER :: const_g33_dac(:) => null()
103 REAL(kind=dp), POINTER :: const_g33_dbc(:) => null()
104 LOGICAL, POINTER :: g33_intermolecular(:) => null()
105 LOGICAL, POINTER :: g33_restraint(:) => null() ! Restraints control
106 REAL(kind=dp), POINTER :: g33_k0(:) => null() ! Restraints control
107 LOGICAL, POINTER, DIMENSION(:) :: g33_exclude_qm => null(), g33_exclude_mm => null()
108 ! G4x6
109 INTEGER :: nconst_g46 = -1
110 INTEGER, POINTER :: const_g46_mol(:) => null()
111 CHARACTER(LEN=default_string_length), POINTER :: const_g46_molname(:) => null()
112 INTEGER, POINTER :: const_g46_a(:) => null()
113 INTEGER, POINTER :: const_g46_b(:) => null()
114 INTEGER, POINTER :: const_g46_c(:) => null()
115 INTEGER, POINTER :: const_g46_d(:) => null()
116 REAL(kind=dp), POINTER :: const_g46_dab(:) => null()
117 REAL(kind=dp), POINTER :: const_g46_dac(:) => null()
118 REAL(kind=dp), POINTER :: const_g46_dbc(:) => null()
119 REAL(kind=dp), POINTER :: const_g46_dad(:) => null()
120 REAL(kind=dp), POINTER :: const_g46_dbd(:) => null()
121 REAL(kind=dp), POINTER :: const_g46_dcd(:) => null()
122 LOGICAL, POINTER :: g46_intermolecular(:) => null()
123 LOGICAL, POINTER :: g46_restraint(:) => null() ! Restraints control
124 REAL(kind=dp), POINTER :: g46_k0(:) => null() ! Restraints control
125 LOGICAL, POINTER, DIMENSION(:) :: g46_exclude_qm => null(), g46_exclude_mm => null()
126 ! virtual_site
127 INTEGER :: nconst_vsite = -1
128 INTEGER, POINTER :: const_vsite_mol(:) => null()
129 CHARACTER(LEN=default_string_length), POINTER :: const_vsite_molname(:) => null()
130 INTEGER, POINTER :: const_vsite_a(:) => null()
131 INTEGER, POINTER :: const_vsite_b(:) => null()
132 INTEGER, POINTER :: const_vsite_c(:) => null()
133 INTEGER, POINTER :: const_vsite_d(:) => null()
134 REAL(kind=dp), POINTER :: const_vsite_wbc(:) => null()
135 REAL(kind=dp), POINTER :: const_vsite_wdc(:) => null()
136 LOGICAL, POINTER :: vsite_intermolecular(:) => null()
137 LOGICAL, POINTER :: vsite_restraint(:) => null() ! Restraints control
138 REAL(kind=dp), POINTER :: vsite_k0(:) => null() ! Restraints control
139 LOGICAL, POINTER, DIMENSION(:) :: vsite_exclude_qm => null(), vsite_exclude_mm => null()
140 END TYPE constraint_info_type
141
142! **************************************************************************************************
144 TYPE(atom_info_type), POINTER :: atom_info => null()
145 TYPE(connectivity_info_type), POINTER :: conn_info => null()
146 TYPE(constraint_info_type), POINTER :: cons_info => null()
147 TYPE(cell_type), POINTER :: cell => null(), cell_ref => null(), cell_muc => null()
148 INTEGER :: conn_type = -1
149 INTEGER :: coord_type = -1
150 INTEGER :: exclude_vdw = -1
151 INTEGER :: exclude_ei = -1
152 INTEGER :: bondparm_type = -1
153 !TRY TO REMOVE THIS FIVE VARIABLE IN THE FUTURE
154 INTEGER :: natoms = -1, natom_type = -1, natom_muc = -1
155 INTEGER :: nmol = -1, nmol_type = -1, nmol_conn = -1
156 !TRY TO REMOVE THIS FIVE VARIABLE IN THE FUTURE
157 LOGICAL :: aa_element = .false.
158 LOGICAL :: molname_generated = .false.
159 REAL(kind=dp) :: bondparm_factor = -1.0_dp
160 LOGICAL :: create_molecules = .false.
161 LOGICAL :: reorder_atom = .false.
162 LOGICAL :: molecules_check = .false.
163 LOGICAL :: coordinate = .false.
164 LOGICAL :: use_g96_velocity = .false.
165 CHARACTER(LEN=default_path_length) :: coord_file_name = ""
166 CHARACTER(LEN=default_path_length) :: conn_file_name = ""
167 LOGICAL :: const_atom = .false.
168 LOGICAL :: const_hydr = .false.
169 LOGICAL :: const_colv = .false.
170 LOGICAL :: const_33 = .false.
171 LOGICAL :: const_46 = .false.
172 LOGICAL :: const_vsite = .false.
173 LOGICAL :: charge_occup = .false.
174 LOGICAL :: charge_beta = .false.
175 LOGICAL :: charge_extended = .false.
176 LOGICAL :: para_res = .false.
178
179! **************************************************************************************************
181 INTEGER, DIMENSION(:), POINTER :: constr => null()
182 END TYPE constr_list_type
183
184 PUBLIC :: atom_info_type, &
189
190 PUBLIC :: init_topology, &
193
194 CHARACTER(len=*), PARAMETER, PRIVATE :: modulen = 'topology_types'
195 PRIVATE
196
197CONTAINS
198
199! **************************************************************************************************
200!> \brief 1. Just NULLIFY and zero all the stuff
201!> \param topology ...
202!> \par History
203!> none
204! **************************************************************************************************
205 SUBROUTINE init_topology(topology)
206 TYPE(topology_parameters_type), INTENT(INOUT) :: topology
207
208!-----------------------------------------------------------------------------
209! 1. Nullify and allocate things in topology
210!-----------------------------------------------------------------------------
211
212 ALLOCATE (topology%atom_info)
213 ALLOCATE (topology%conn_info)
214 ALLOCATE (topology%cons_info)
215 !-----------------------------------------------------------------------------
216 ! 2. Initialize and Nullify things in topology
217 !-----------------------------------------------------------------------------
218 NULLIFY (topology%cell, topology%cell_ref, topology%cell_muc)
219 topology%natoms = 0
220 topology%natom_muc = 0
221 topology%natom_type = 0
222 topology%nmol = 0
223 topology%nmol_type = 0
224 topology%nmol_conn = 0
225 topology%bondparm_type = do_bondparm_covalent
226 topology%reorder_atom = .false.
227 topology%create_molecules = .false.
228 topology%molecules_check = .false.
229 topology%coordinate = .false.
230 topology%use_g96_velocity = .false.
231 topology%coord_type = -1
232 topology%coord_file_name = ''
233 topology%conn_type = do_conn_generate
234 topology%conn_file_name = 'OFF'
235 topology%const_atom = .false.
236 topology%const_hydr = .false.
237 topology%const_colv = .false.
238 topology%const_33 = .false.
239 topology%const_46 = .false.
240 topology%const_vsite = .false.
241 topology%charge_occup = .false.
242 topology%charge_beta = .false.
243 topology%charge_extended = .false.
244 topology%para_res = .false.
245 topology%molname_generated = .false.
246 topology%aa_element = .false.
247 topology%exclude_vdw = do_skip_13
248 topology%exclude_ei = do_skip_13
249 !-----------------------------------------------------------------------------
250 ! 3. Initialize and Nullify things in topology%atom_info
251 !-----------------------------------------------------------------------------
252 NULLIFY (topology%atom_info%id_molname)
253 NULLIFY (topology%atom_info%id_resname)
254 NULLIFY (topology%atom_info%resid)
255 NULLIFY (topology%atom_info%id_atmname)
256 NULLIFY (topology%atom_info%id_atom_names)
257 NULLIFY (topology%atom_info%r)
258 NULLIFY (topology%atom_info%map_mol_typ)
259 NULLIFY (topology%atom_info%map_mol_num)
260 NULLIFY (topology%atom_info%map_mol_res)
261 NULLIFY (topology%atom_info%atm_charge)
262 NULLIFY (topology%atom_info%atm_mass)
263 NULLIFY (topology%atom_info%occup)
264 NULLIFY (topology%atom_info%beta)
265 NULLIFY (topology%atom_info%id_element)
266 !-----------------------------------------------------------------------------
267 ! 4. Initialize and Nullify things in topology%conn_info
268 !-----------------------------------------------------------------------------
269 NULLIFY (topology%conn_info%bond_a)
270 NULLIFY (topology%conn_info%bond_b)
271 NULLIFY (topology%conn_info%bond_type)
272 NULLIFY (topology%conn_info%ub_a)
273 NULLIFY (topology%conn_info%ub_b)
274 NULLIFY (topology%conn_info%ub_c)
275 NULLIFY (topology%conn_info%theta_a)
276 NULLIFY (topology%conn_info%theta_b)
277 NULLIFY (topology%conn_info%theta_c)
278 NULLIFY (topology%conn_info%theta_type)
279 NULLIFY (topology%conn_info%phi_a)
280 NULLIFY (topology%conn_info%phi_b)
281 NULLIFY (topology%conn_info%phi_c)
282 NULLIFY (topology%conn_info%phi_d)
283 NULLIFY (topology%conn_info%phi_type)
284 NULLIFY (topology%conn_info%impr_a)
285 NULLIFY (topology%conn_info%impr_b)
286 NULLIFY (topology%conn_info%impr_c)
287 NULLIFY (topology%conn_info%impr_d)
288 NULLIFY (topology%conn_info%impr_type)
289 NULLIFY (topology%conn_info%onfo_a)
290 NULLIFY (topology%conn_info%onfo_b)
291 NULLIFY (topology%conn_info%c_bond_a)
292 NULLIFY (topology%conn_info%c_bond_b)
293 NULLIFY (topology%conn_info%c_bond_type)
294 !-----------------------------------------------------------------------------
295 ! 5. Initialize and Nullify things in topology%cons_info
296 !-----------------------------------------------------------------------------
297 CALL init_constraint(topology%cons_info)
298 END SUBROUTINE init_topology
299
300! **************************************************************************************************
301!> \brief 1. Just NULLIFY and zero all the stuff
302!> \param constraint_info ...
303!> \par History
304!> none
305! **************************************************************************************************
306 SUBROUTINE init_constraint(constraint_info)
307 TYPE(constraint_info_type), POINTER :: constraint_info
308
309! Bonds involving Hydrogens
310
311 constraint_info%hbonds_restraint = .false.
312 ! Fixed Atoms
313 constraint_info%nfixed_atoms = 0
314 constraint_info%freeze_mm = do_constr_none
315 constraint_info%freeze_qm = do_constr_none
316 NULLIFY (constraint_info%fixed_atoms)
317 NULLIFY (constraint_info%fixed_type)
318 NULLIFY (constraint_info%fixed_mol_type)
319 NULLIFY (constraint_info%fixed_molnames)
320 NULLIFY (constraint_info%fixed_restraint)
321 NULLIFY (constraint_info%fixed_k0)
322 NULLIFY (constraint_info%fixed_mol_restraint)
323 NULLIFY (constraint_info%fixed_mol_k0)
324 NULLIFY (constraint_info%fixed_exclude_qm, constraint_info%fixed_exclude_mm)
325 ! Collective Constraints
326 constraint_info%nconst_colv = 0
327 NULLIFY (constraint_info%colvar_set)
328 NULLIFY (constraint_info%const_colv_mol)
329 NULLIFY (constraint_info%const_colv_molname)
330 NULLIFY (constraint_info%const_colv_target)
331 NULLIFY (constraint_info%const_colv_target_growth)
332 NULLIFY (constraint_info%colv_intermolecular)
333 NULLIFY (constraint_info%colv_restraint)
334 NULLIFY (constraint_info%colv_k0)
335 NULLIFY (constraint_info%colv_exclude_qm, constraint_info%colv_exclude_mm)
336 ! G3x3
337 constraint_info%nconst_g33 = 0
338 NULLIFY (constraint_info%const_g33_mol)
339 NULLIFY (constraint_info%const_g33_molname)
340 NULLIFY (constraint_info%const_g33_a)
341 NULLIFY (constraint_info%const_g33_b)
342 NULLIFY (constraint_info%const_g33_c)
343 NULLIFY (constraint_info%const_g33_dab)
344 NULLIFY (constraint_info%const_g33_dac)
345 NULLIFY (constraint_info%const_g33_dbc)
346 NULLIFY (constraint_info%g33_intermolecular)
347 NULLIFY (constraint_info%g33_restraint)
348 NULLIFY (constraint_info%g33_k0)
349 NULLIFY (constraint_info%g33_exclude_qm, constraint_info%g33_exclude_mm)
350 ! G4x6
351 constraint_info%nconst_g46 = 0
352 NULLIFY (constraint_info%const_g46_mol)
353 NULLIFY (constraint_info%const_g46_molname)
354 NULLIFY (constraint_info%const_g46_a)
355 NULLIFY (constraint_info%const_g46_b)
356 NULLIFY (constraint_info%const_g46_c)
357 NULLIFY (constraint_info%const_g46_d)
358 NULLIFY (constraint_info%const_g46_dab)
359 NULLIFY (constraint_info%const_g46_dac)
360 NULLIFY (constraint_info%const_g46_dbc)
361 NULLIFY (constraint_info%const_g46_dad)
362 NULLIFY (constraint_info%const_g46_dbd)
363 NULLIFY (constraint_info%const_g46_dcd)
364 NULLIFY (constraint_info%g46_intermolecular)
365 NULLIFY (constraint_info%g46_restraint)
366 NULLIFY (constraint_info%g46_k0)
367 NULLIFY (constraint_info%g46_exclude_qm, constraint_info%g46_exclude_mm)
368 ! virtual_site
369 constraint_info%nconst_vsite = 0
370 NULLIFY (constraint_info%const_vsite_mol)
371 NULLIFY (constraint_info%const_vsite_molname)
372 NULLIFY (constraint_info%const_vsite_a)
373 NULLIFY (constraint_info%const_vsite_b)
374 NULLIFY (constraint_info%const_vsite_c)
375 NULLIFY (constraint_info%const_vsite_d)
376 NULLIFY (constraint_info%const_vsite_wbc)
377 NULLIFY (constraint_info%const_vsite_wdc)
378 NULLIFY (constraint_info%vsite_intermolecular)
379 NULLIFY (constraint_info%vsite_restraint)
380 NULLIFY (constraint_info%vsite_k0)
381 NULLIFY (constraint_info%vsite_exclude_qm, constraint_info%vsite_exclude_mm)
382
383 END SUBROUTINE init_constraint
384
385! **************************************************************************************************
386!> \brief 1. Just DEALLOCATE all the stuff
387!> \param topology ...
388!> \par History
389!> none
390! **************************************************************************************************
391 SUBROUTINE deallocate_topology(topology)
392 TYPE(topology_parameters_type), INTENT(INOUT) :: topology
393
394!-----------------------------------------------------------------------------
395! 1. DEALLOCATE things in topology%atom_info
396!-----------------------------------------------------------------------------
397
398 IF (ASSOCIATED(topology%atom_info%id_molname)) THEN
399 DEALLOCATE (topology%atom_info%id_molname)
400 END IF
401 IF (ASSOCIATED(topology%atom_info%id_resname)) THEN
402 DEALLOCATE (topology%atom_info%id_resname)
403 END IF
404 IF (ASSOCIATED(topology%atom_info%resid)) THEN
405 DEALLOCATE (topology%atom_info%resid)
406 END IF
407 IF (ASSOCIATED(topology%atom_info%id_atmname)) THEN
408 DEALLOCATE (topology%atom_info%id_atmname)
409 END IF
410 IF (ASSOCIATED(topology%atom_info%id_atom_names)) THEN
411 DEALLOCATE (topology%atom_info%id_atom_names)
412 END IF
413 IF (ASSOCIATED(topology%atom_info%r)) THEN
414 DEALLOCATE (topology%atom_info%r)
415 END IF
416 IF (ASSOCIATED(topology%atom_info%map_mol_typ)) THEN
417 DEALLOCATE (topology%atom_info%map_mol_typ)
418 END IF
419 IF (ASSOCIATED(topology%atom_info%map_mol_num)) THEN
420 DEALLOCATE (topology%atom_info%map_mol_num)
421 END IF
422 IF (ASSOCIATED(topology%atom_info%map_mol_res)) THEN
423 DEALLOCATE (topology%atom_info%map_mol_res)
424 END IF
425 IF (ASSOCIATED(topology%atom_info%atm_charge)) THEN
426 DEALLOCATE (topology%atom_info%atm_charge)
427 END IF
428 IF (ASSOCIATED(topology%atom_info%atm_mass)) THEN
429 DEALLOCATE (topology%atom_info%atm_mass)
430 END IF
431 IF (ASSOCIATED(topology%atom_info%occup)) THEN
432 DEALLOCATE (topology%atom_info%occup)
433 END IF
434 IF (ASSOCIATED(topology%atom_info%beta)) THEN
435 DEALLOCATE (topology%atom_info%beta)
436 END IF
437 IF (ASSOCIATED(topology%atom_info%id_element)) THEN
438 DEALLOCATE (topology%atom_info%id_element)
439 END IF
440 !-----------------------------------------------------------------------------
441 ! 2. DEALLOCATE things in topology%conn_info
442 !-----------------------------------------------------------------------------
443 IF (ASSOCIATED(topology%conn_info%bond_a)) THEN
444 DEALLOCATE (topology%conn_info%bond_a)
445 END IF
446 IF (ASSOCIATED(topology%conn_info%bond_b)) THEN
447 DEALLOCATE (topology%conn_info%bond_b)
448 END IF
449 IF (ASSOCIATED(topology%conn_info%bond_type)) THEN
450 DEALLOCATE (topology%conn_info%bond_type)
451 END IF
452 IF (ASSOCIATED(topology%conn_info%ub_a)) THEN
453 DEALLOCATE (topology%conn_info%ub_a)
454 END IF
455 IF (ASSOCIATED(topology%conn_info%ub_b)) THEN
456 DEALLOCATE (topology%conn_info%ub_b)
457 END IF
458 IF (ASSOCIATED(topology%conn_info%ub_c)) THEN
459 DEALLOCATE (topology%conn_info%ub_c)
460 END IF
461 IF (ASSOCIATED(topology%conn_info%theta_a)) THEN
462 DEALLOCATE (topology%conn_info%theta_a)
463 END IF
464 IF (ASSOCIATED(topology%conn_info%theta_b)) THEN
465 DEALLOCATE (topology%conn_info%theta_b)
466 END IF
467 IF (ASSOCIATED(topology%conn_info%theta_c)) THEN
468 DEALLOCATE (topology%conn_info%theta_c)
469 END IF
470 IF (ASSOCIATED(topology%conn_info%theta_type)) THEN
471 DEALLOCATE (topology%conn_info%theta_type)
472 END IF
473 IF (ASSOCIATED(topology%conn_info%phi_a)) THEN
474 DEALLOCATE (topology%conn_info%phi_a)
475 END IF
476 IF (ASSOCIATED(topology%conn_info%phi_b)) THEN
477 DEALLOCATE (topology%conn_info%phi_b)
478 END IF
479 IF (ASSOCIATED(topology%conn_info%phi_c)) THEN
480 DEALLOCATE (topology%conn_info%phi_c)
481 END IF
482 IF (ASSOCIATED(topology%conn_info%phi_d)) THEN
483 DEALLOCATE (topology%conn_info%phi_d)
484 END IF
485 IF (ASSOCIATED(topology%conn_info%phi_type)) THEN
486 DEALLOCATE (topology%conn_info%phi_type)
487 END IF
488 IF (ASSOCIATED(topology%conn_info%impr_a)) THEN
489 DEALLOCATE (topology%conn_info%impr_a)
490 END IF
491 IF (ASSOCIATED(topology%conn_info%impr_b)) THEN
492 DEALLOCATE (topology%conn_info%impr_b)
493 END IF
494 IF (ASSOCIATED(topology%conn_info%impr_c)) THEN
495 DEALLOCATE (topology%conn_info%impr_c)
496 END IF
497 IF (ASSOCIATED(topology%conn_info%impr_d)) THEN
498 DEALLOCATE (topology%conn_info%impr_d)
499 END IF
500 IF (ASSOCIATED(topology%conn_info%impr_type)) THEN
501 DEALLOCATE (topology%conn_info%impr_type)
502 END IF
503 IF (ASSOCIATED(topology%conn_info%onfo_a)) THEN
504 DEALLOCATE (topology%conn_info%onfo_a)
505 END IF
506 IF (ASSOCIATED(topology%conn_info%onfo_b)) THEN
507 DEALLOCATE (topology%conn_info%onfo_b)
508 END IF
509 IF (ASSOCIATED(topology%conn_info%c_bond_a)) THEN
510 DEALLOCATE (topology%conn_info%c_bond_a)
511 END IF
512 IF (ASSOCIATED(topology%conn_info%c_bond_b)) THEN
513 DEALLOCATE (topology%conn_info%c_bond_b)
514 END IF
515 IF (ASSOCIATED(topology%conn_info%c_bond_type)) THEN
516 DEALLOCATE (topology%conn_info%c_bond_type)
517 END IF
518 !-----------------------------------------------------------------------------
519 ! 3. DEALLOCATE things in topology%cons_info
520 !-----------------------------------------------------------------------------
521 IF (ASSOCIATED(topology%cons_info)) &
522 CALL deallocate_constraint(topology%cons_info)
523 !-----------------------------------------------------------------------------
524 ! 4. DEALLOCATE things in topology
525 !-----------------------------------------------------------------------------
526 CALL cell_release(topology%cell)
527 CALL cell_release(topology%cell_ref)
528 CALL cell_release(topology%cell_muc)
529 IF (ASSOCIATED(topology%atom_info)) THEN
530 DEALLOCATE (topology%atom_info)
531 END IF
532 IF (ASSOCIATED(topology%conn_info)) THEN
533 DEALLOCATE (topology%conn_info)
534 END IF
535 IF (ASSOCIATED(topology%cons_info)) THEN
536 DEALLOCATE (topology%cons_info)
537 END IF
538
539 END SUBROUTINE deallocate_topology
540
541! **************************************************************************************************
542!> \brief 1. Just DEALLOCATE all the stuff
543!> \param constraint_info ...
544!> \par History
545!> none
546! **************************************************************************************************
547 SUBROUTINE deallocate_constraint(constraint_info)
548 TYPE(constraint_info_type), POINTER :: constraint_info
549
550 INTEGER :: i
551
552! Fixed Atoms
553
554 IF (ASSOCIATED(constraint_info%fixed_atoms)) THEN
555 DEALLOCATE (constraint_info%fixed_atoms)
556 END IF
557 IF (ASSOCIATED(constraint_info%fixed_type)) THEN
558 DEALLOCATE (constraint_info%fixed_type)
559 END IF
560 IF (ASSOCIATED(constraint_info%fixed_molnames)) THEN
561 DEALLOCATE (constraint_info%fixed_molnames)
562 END IF
563 IF (ASSOCIATED(constraint_info%fixed_mol_type)) THEN
564 DEALLOCATE (constraint_info%fixed_mol_type)
565 END IF
566 IF (ASSOCIATED(constraint_info%fixed_restraint)) THEN
567 DEALLOCATE (constraint_info%fixed_restraint)
568 END IF
569 IF (ASSOCIATED(constraint_info%fixed_k0)) THEN
570 DEALLOCATE (constraint_info%fixed_k0)
571 END IF
572 IF (ASSOCIATED(constraint_info%fixed_mol_restraint)) THEN
573 DEALLOCATE (constraint_info%fixed_mol_restraint)
574 END IF
575 IF (ASSOCIATED(constraint_info%fixed_mol_k0)) THEN
576 DEALLOCATE (constraint_info%fixed_mol_k0)
577 END IF
578 IF (ASSOCIATED(constraint_info%fixed_exclude_qm)) THEN
579 DEALLOCATE (constraint_info%fixed_exclude_qm)
580 END IF
581 IF (ASSOCIATED(constraint_info%fixed_exclude_mm)) THEN
582 DEALLOCATE (constraint_info%fixed_exclude_mm)
583 END IF
584 ! Collective Constraint
585 IF (ASSOCIATED(constraint_info%colvar_set)) THEN
586 DO i = 1, SIZE(constraint_info%colvar_set)
587 IF (ASSOCIATED(constraint_info%colvar_set(i)%colvar)) THEN
588 CALL colvar_release(constraint_info%colvar_set(i)%colvar)
589 NULLIFY (constraint_info%colvar_set(i)%colvar)
590 END IF
591 END DO
592 DEALLOCATE (constraint_info%colvar_set)
593 END IF
594 IF (ASSOCIATED(constraint_info%const_colv_mol)) THEN
595 DEALLOCATE (constraint_info%const_colv_mol)
596 END IF
597 IF (ASSOCIATED(constraint_info%const_colv_molname)) THEN
598 DEALLOCATE (constraint_info%const_colv_molname)
599 END IF
600 IF (ASSOCIATED(constraint_info%const_colv_target)) THEN
601 DEALLOCATE (constraint_info%const_colv_target)
602 END IF
603 IF (ASSOCIATED(constraint_info%const_colv_target_growth)) THEN
604 DEALLOCATE (constraint_info%const_colv_target_growth)
605 END IF
606 IF (ASSOCIATED(constraint_info%colv_intermolecular)) THEN
607 DEALLOCATE (constraint_info%colv_intermolecular)
608 END IF
609 IF (ASSOCIATED(constraint_info%colv_restraint)) THEN
610 DEALLOCATE (constraint_info%colv_restraint)
611 END IF
612 IF (ASSOCIATED(constraint_info%colv_k0)) THEN
613 DEALLOCATE (constraint_info%colv_k0)
614 END IF
615 IF (ASSOCIATED(constraint_info%colv_exclude_qm)) THEN
616 DEALLOCATE (constraint_info%colv_exclude_qm)
617 END IF
618 IF (ASSOCIATED(constraint_info%colv_exclude_mm)) THEN
619 DEALLOCATE (constraint_info%colv_exclude_mm)
620 END IF
621 ! G3x3
622 IF (ASSOCIATED(constraint_info%const_g33_mol)) THEN
623 DEALLOCATE (constraint_info%const_g33_mol)
624 END IF
625 IF (ASSOCIATED(constraint_info%const_g33_molname)) THEN
626 DEALLOCATE (constraint_info%const_g33_molname)
627 END IF
628 IF (ASSOCIATED(constraint_info%const_g33_a)) THEN
629 DEALLOCATE (constraint_info%const_g33_a)
630 END IF
631 IF (ASSOCIATED(constraint_info%const_g33_b)) THEN
632 DEALLOCATE (constraint_info%const_g33_b)
633 END IF
634 IF (ASSOCIATED(constraint_info%const_g33_c)) THEN
635 DEALLOCATE (constraint_info%const_g33_c)
636 END IF
637 IF (ASSOCIATED(constraint_info%const_g33_dab)) THEN
638 DEALLOCATE (constraint_info%const_g33_dab)
639 END IF
640 IF (ASSOCIATED(constraint_info%const_g33_dac)) THEN
641 DEALLOCATE (constraint_info%const_g33_dac)
642 END IF
643 IF (ASSOCIATED(constraint_info%const_g33_dbc)) THEN
644 DEALLOCATE (constraint_info%const_g33_dbc)
645 END IF
646 IF (ASSOCIATED(constraint_info%g33_intermolecular)) THEN
647 DEALLOCATE (constraint_info%g33_intermolecular)
648 END IF
649 IF (ASSOCIATED(constraint_info%g33_restraint)) THEN
650 DEALLOCATE (constraint_info%g33_restraint)
651 END IF
652 IF (ASSOCIATED(constraint_info%g33_k0)) THEN
653 DEALLOCATE (constraint_info%g33_k0)
654 END IF
655 IF (ASSOCIATED(constraint_info%g33_exclude_qm)) THEN
656 DEALLOCATE (constraint_info%g33_exclude_qm)
657 END IF
658 IF (ASSOCIATED(constraint_info%g33_exclude_mm)) THEN
659 DEALLOCATE (constraint_info%g33_exclude_mm)
660 END IF
661 ! G4x6
662 IF (ASSOCIATED(constraint_info%const_g46_mol)) THEN
663 DEALLOCATE (constraint_info%const_g46_mol)
664 END IF
665 IF (ASSOCIATED(constraint_info%const_g46_molname)) THEN
666 DEALLOCATE (constraint_info%const_g46_molname)
667 END IF
668 IF (ASSOCIATED(constraint_info%const_g46_a)) THEN
669 DEALLOCATE (constraint_info%const_g46_a)
670 END IF
671 IF (ASSOCIATED(constraint_info%const_g46_b)) THEN
672 DEALLOCATE (constraint_info%const_g46_b)
673 END IF
674 IF (ASSOCIATED(constraint_info%const_g46_c)) THEN
675 DEALLOCATE (constraint_info%const_g46_c)
676 END IF
677 IF (ASSOCIATED(constraint_info%const_g46_d)) THEN
678 DEALLOCATE (constraint_info%const_g46_d)
679 END IF
680 IF (ASSOCIATED(constraint_info%const_g46_dab)) THEN
681 DEALLOCATE (constraint_info%const_g46_dab)
682 END IF
683 IF (ASSOCIATED(constraint_info%const_g46_dac)) THEN
684 DEALLOCATE (constraint_info%const_g46_dac)
685 END IF
686 IF (ASSOCIATED(constraint_info%const_g46_dbc)) THEN
687 DEALLOCATE (constraint_info%const_g46_dbc)
688 END IF
689 IF (ASSOCIATED(constraint_info%const_g46_dad)) THEN
690 DEALLOCATE (constraint_info%const_g46_dad)
691 END IF
692 IF (ASSOCIATED(constraint_info%const_g46_dbd)) THEN
693 DEALLOCATE (constraint_info%const_g46_dbd)
694 END IF
695 IF (ASSOCIATED(constraint_info%const_g46_dcd)) THEN
696 DEALLOCATE (constraint_info%const_g46_dcd)
697 END IF
698 IF (ASSOCIATED(constraint_info%g46_intermolecular)) THEN
699 DEALLOCATE (constraint_info%g46_intermolecular)
700 END IF
701 IF (ASSOCIATED(constraint_info%g46_restraint)) THEN
702 DEALLOCATE (constraint_info%g46_restraint)
703 END IF
704 IF (ASSOCIATED(constraint_info%g46_k0)) THEN
705 DEALLOCATE (constraint_info%g46_k0)
706 END IF
707 IF (ASSOCIATED(constraint_info%g46_exclude_qm)) THEN
708 DEALLOCATE (constraint_info%g46_exclude_qm)
709 END IF
710 IF (ASSOCIATED(constraint_info%g46_exclude_mm)) THEN
711 DEALLOCATE (constraint_info%g46_exclude_mm)
712 END IF
713 ! virtual_site
714 IF (ASSOCIATED(constraint_info%const_vsite_mol)) THEN
715 DEALLOCATE (constraint_info%const_vsite_mol)
716 END IF
717 IF (ASSOCIATED(constraint_info%const_vsite_molname)) THEN
718 DEALLOCATE (constraint_info%const_vsite_molname)
719 END IF
720 IF (ASSOCIATED(constraint_info%const_vsite_a)) THEN
721 DEALLOCATE (constraint_info%const_vsite_a)
722 END IF
723 IF (ASSOCIATED(constraint_info%const_vsite_b)) THEN
724 DEALLOCATE (constraint_info%const_vsite_b)
725 END IF
726 IF (ASSOCIATED(constraint_info%const_vsite_c)) THEN
727 DEALLOCATE (constraint_info%const_vsite_c)
728 END IF
729 IF (ASSOCIATED(constraint_info%const_vsite_d)) THEN
730 DEALLOCATE (constraint_info%const_vsite_d)
731 END IF
732 IF (ASSOCIATED(constraint_info%const_vsite_wbc)) THEN
733 DEALLOCATE (constraint_info%const_vsite_wbc)
734 END IF
735 IF (ASSOCIATED(constraint_info%const_vsite_wdc)) THEN
736 DEALLOCATE (constraint_info%const_vsite_wdc)
737 END IF
738 IF (ASSOCIATED(constraint_info%vsite_intermolecular)) THEN
739 DEALLOCATE (constraint_info%vsite_intermolecular)
740 END IF
741 IF (ASSOCIATED(constraint_info%vsite_restraint)) THEN
742 DEALLOCATE (constraint_info%vsite_restraint)
743 END IF
744 IF (ASSOCIATED(constraint_info%vsite_k0)) THEN
745 DEALLOCATE (constraint_info%vsite_k0)
746 END IF
747 IF (ASSOCIATED(constraint_info%vsite_exclude_qm)) THEN
748 DEALLOCATE (constraint_info%vsite_exclude_qm)
749 END IF
750 IF (ASSOCIATED(constraint_info%vsite_exclude_mm)) THEN
751 DEALLOCATE (constraint_info%vsite_exclude_mm)
752 END IF
753 END SUBROUTINE deallocate_constraint
754
755! **************************************************************************************************
756!> \brief Deallocate possibly allocated arrays before reading topology
757!> \param topology ...
758!> \par History
759!> none
760! **************************************************************************************************
761 SUBROUTINE pre_read_topology(topology)
762 TYPE(topology_parameters_type), INTENT(INOUT) :: topology
763
764 TYPE(atom_info_type), POINTER :: atom_info
765
766 atom_info => topology%atom_info
767
768 IF (ASSOCIATED(atom_info%id_molname)) THEN
769 DEALLOCATE (atom_info%id_molname)
770 END IF
771
772 IF (ASSOCIATED(atom_info%resid)) THEN
773 DEALLOCATE (atom_info%resid)
774 END IF
775
776 IF (ASSOCIATED(atom_info%id_resname)) THEN
777 DEALLOCATE (atom_info%id_resname)
778 END IF
779
780 IF (ASSOCIATED(atom_info%id_atmname)) THEN
781 DEALLOCATE (atom_info%id_atmname)
782 END IF
783
784 IF (ASSOCIATED(atom_info%atm_charge)) THEN
785 DEALLOCATE (atom_info%atm_charge)
786 END IF
787
788 IF (ASSOCIATED(atom_info%atm_mass)) THEN
789 DEALLOCATE (atom_info%atm_mass)
790 END IF
791
792 END SUBROUTINE pre_read_topology
793
794END MODULE topology_types
Handles all functions related to the CELL.
Definition cell_types.F:15
subroutine, public cell_release(cell)
releases the given cell (see doc/ReferenceCounting.html)
Definition cell_types.F:559
Initialize the collective variables types.
recursive subroutine, public colvar_release(colvar)
releases the memory that might have been allocated by the colvar
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public do_skip_13
integer, parameter, public do_bondparm_covalent
integer, parameter, public do_conn_generate
integer, parameter, public do_constr_none
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
subroutine, public deallocate_topology(topology)
Just DEALLOCATE all the stuff
subroutine, public pre_read_topology(topology)
Deallocate possibly allocated arrays before reading topology.
subroutine, public init_topology(topology)
Just NULLIFY and zero all the stuff
Control for reading in different topologies and coordinates.
Definition topology.F:13
Type defining parameters related to the simulation cell.
Definition cell_types.F:55