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