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 all structure types related to force field kinds
8!> \par History
9!>      10.2014 Moved kind types out of force_field_types.F [Ole Schuett]
10!> \author Ole Schuett
11! **************************************************************************************************
12MODULE force_field_kind_types
13
14   USE kinds,                           ONLY: dp
15#include "../base/base_uses.f90"
16
17   IMPLICIT NONE
18
19   PRIVATE
20
21   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'force_field_kind_types'
22
23   INTEGER, PARAMETER, PUBLIC               :: do_ff_undef = 0, &
24                                               do_ff_quartic = 1, &
25                                               do_ff_g96 = 2, &
26                                               do_ff_charmm = 3, &
27                                               do_ff_harmonic = 4, &
28                                               do_ff_g87 = 5, &
29                                               do_ff_morse = 6, &
30                                               do_ff_cubic = 7, &
31                                               do_ff_mixed_bend_stretch = 8, &
32                                               do_ff_amber = 9, &
33                                               do_ff_mm2 = 10, &
34                                               do_ff_mm3 = 11, &
35                                               do_ff_mm4 = 12, &
36                                               do_ff_fues = 13, &
37                                               do_ff_legendre = 14, &
38                                               do_ff_opls = 15
39
40! *** Define the derived structure types ***
41
42! **************************************************************************************************
43   TYPE legendre_data_type
44      INTEGER :: order
45      REAL(KIND=dp), DIMENSION(:), POINTER :: coeffs
46   END TYPE legendre_data_type
47
48! **************************************************************************************************
49   TYPE bond_kind_type
50      INTEGER                        :: id_type
51      REAL(KIND=dp)                :: k(3), r0, cs
52      INTEGER                        :: kind_number
53   END TYPE bond_kind_type
54
55! **************************************************************************************************
56   TYPE bend_kind_type
57      INTEGER                        :: id_type
58      REAL(KIND=dp)                :: k, theta0, cb
59      REAL(KIND=dp)                :: r012, r032, kbs12, kbs32, kss
60      TYPE(legendre_data_type)       :: legendre
61      INTEGER                        :: kind_number
62   END TYPE bend_kind_type
63
64! **************************************************************************************************
65   TYPE ub_kind_type
66      INTEGER                        :: id_type
67      REAL(KIND=dp)                :: k(3), r0
68      INTEGER                        :: kind_number
69   END TYPE ub_kind_type
70
71! **************************************************************************************************
72   TYPE torsion_kind_type
73      INTEGER                        :: id_type
74      INTEGER                        :: nmul
75      INTEGER, POINTER               :: m(:)
76      REAL(KIND=dp), POINTER       :: k(:), phi0(:)
77      INTEGER                        :: kind_number
78   END TYPE torsion_kind_type
79
80! **************************************************************************************************
81   TYPE impr_kind_type
82      INTEGER                        :: id_type
83      REAL(KIND=dp)                :: k, phi0
84      INTEGER                        :: kind_number
85   END TYPE impr_kind_type
86
87! **************************************************************************************************
88   TYPE opbend_kind_type
89      INTEGER                        :: id_type
90      REAL(KIND=dp)                :: k, phi0
91      INTEGER                        :: kind_number
92   END TYPE opbend_kind_type
93
94! *** Public subroutines ***
95
96   PUBLIC :: allocate_bend_kind_set, &
97             allocate_bond_kind_set, &
98             allocate_ub_kind_set, &
99             allocate_torsion_kind_set, &
100             allocate_impr_kind_set, &
101             allocate_opbend_kind_set, &
102             deallocate_bend_kind_set, &
103             deallocate_bond_kind_set, &
104             torsion_kind_dealloc_ref, &
105             impr_kind_dealloc_ref
106
107! *** Public data types ***
108
109   PUBLIC :: bend_kind_type, &
110             bond_kind_type, &
111             impr_kind_type, &
112             torsion_kind_type, &
113             opbend_kind_type, &
114             ub_kind_type, &
115             ub_kind_dealloc_ref, &
116             legendre_data_type
117CONTAINS
118
119! **************************************************************************************************
120!> \brief Allocate and initialize a bend kind set.
121!> \param bend_kind_set ...
122!> \param nkind ...
123! **************************************************************************************************
124   SUBROUTINE allocate_bend_kind_set(bend_kind_set, nkind)
125
126      TYPE(bend_kind_type), DIMENSION(:), POINTER        :: bend_kind_set
127      INTEGER, INTENT(IN)                                :: nkind
128
129      CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_bend_kind_set', &
130         routineP = moduleN//':'//routineN
131
132      INTEGER                                            :: ikind
133
134      NULLIFY (bend_kind_set)
135      ALLOCATE (bend_kind_set(nkind))
136      DO ikind = 1, nkind
137         bend_kind_set(ikind)%id_type = do_ff_undef
138         bend_kind_set(ikind)%k = 0.0_dp
139         bend_kind_set(ikind)%theta0 = 0.0_dp
140         bend_kind_set(ikind)%cb = 0.0_dp
141         bend_kind_set(ikind)%r012 = 0.0_dp
142         bend_kind_set(ikind)%r032 = 0.0_dp
143         bend_kind_set(ikind)%kbs12 = 0.0_dp
144         bend_kind_set(ikind)%kbs32 = 0.0_dp
145         bend_kind_set(ikind)%kss = 0.0_dp
146         bend_kind_set(ikind)%legendre%order = 0
147         NULLIFY (bend_kind_set(ikind)%legendre%coeffs)
148         bend_kind_set(ikind)%kind_number = ikind
149      END DO
150   END SUBROUTINE allocate_bend_kind_set
151
152! **************************************************************************************************
153!> \brief Allocate and initialize a bond kind set.
154!> \param bond_kind_set ...
155!> \param nkind ...
156! **************************************************************************************************
157   SUBROUTINE allocate_bond_kind_set(bond_kind_set, nkind)
158
159      TYPE(bond_kind_type), DIMENSION(:), POINTER        :: bond_kind_set
160      INTEGER, INTENT(IN)                                :: nkind
161
162      CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_bond_kind_set', &
163         routineP = moduleN//':'//routineN
164
165      INTEGER                                            :: ikind
166
167      NULLIFY (bond_kind_set)
168      ALLOCATE (bond_kind_set(nkind))
169      DO ikind = 1, nkind
170         bond_kind_set(ikind)%id_type = do_ff_undef
171         bond_kind_set(ikind)%k(:) = 0.0_dp
172         bond_kind_set(ikind)%r0 = 0.0_dp
173         bond_kind_set(ikind)%cs = 0.0_dp
174         bond_kind_set(ikind)%kind_number = ikind
175      END DO
176   END SUBROUTINE allocate_bond_kind_set
177
178! **************************************************************************************************
179!> \brief Allocate and initialize a torsion kind set.
180!> \param torsion_kind_set ...
181!> \param nkind ...
182! **************************************************************************************************
183   SUBROUTINE allocate_torsion_kind_set(torsion_kind_set, nkind)
184
185      TYPE(torsion_kind_type), DIMENSION(:), POINTER     :: torsion_kind_set
186      INTEGER, INTENT(IN)                                :: nkind
187
188      CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_torsion_kind_set', &
189         routineP = moduleN//':'//routineN
190
191      INTEGER                                            :: ikind
192
193      NULLIFY (torsion_kind_set)
194      ALLOCATE (torsion_kind_set(nkind))
195
196      DO ikind = 1, nkind
197         torsion_kind_set(ikind)%id_type = do_ff_undef
198         torsion_kind_set(ikind)%nmul = 0
199         NULLIFY (torsion_kind_set(ikind)%k)
200         NULLIFY (torsion_kind_set(ikind)%m)
201         NULLIFY (torsion_kind_set(ikind)%phi0)
202         torsion_kind_set(ikind)%kind_number = ikind
203      END DO
204   END SUBROUTINE allocate_torsion_kind_set
205
206! **************************************************************************************************
207!> \brief Allocate and initialize a ub kind set.
208!> \param ub_kind_set ...
209!> \param nkind ...
210! **************************************************************************************************
211   SUBROUTINE allocate_ub_kind_set(ub_kind_set, nkind)
212
213      TYPE(ub_kind_type), DIMENSION(:), POINTER          :: ub_kind_set
214      INTEGER, INTENT(IN)                                :: nkind
215
216      CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_ub_kind_set', &
217         routineP = moduleN//':'//routineN
218
219      INTEGER                                            :: ikind
220
221      NULLIFY (ub_kind_set)
222      ALLOCATE (ub_kind_set(nkind))
223      DO ikind = 1, nkind
224         ub_kind_set(ikind)%id_type = do_ff_undef
225         ub_kind_set(ikind)%k = 0.0_dp
226         ub_kind_set(ikind)%r0 = 0.0_dp
227         ub_kind_set(ikind)%kind_number = ikind
228      END DO
229   END SUBROUTINE allocate_ub_kind_set
230
231! **************************************************************************************************
232!> \brief Allocate and initialize a impr kind set.
233!> \param impr_kind_set ...
234!> \param nkind ...
235! **************************************************************************************************
236   SUBROUTINE allocate_impr_kind_set(impr_kind_set, nkind)
237
238      TYPE(impr_kind_type), DIMENSION(:), POINTER        :: impr_kind_set
239      INTEGER, INTENT(IN)                                :: nkind
240
241      CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_impr_kind_set', &
242         routineP = moduleN//':'//routineN
243
244      INTEGER                                            :: ikind
245
246      NULLIFY (impr_kind_set)
247      ALLOCATE (impr_kind_set(nkind))
248      DO ikind = 1, nkind
249         impr_kind_set(ikind)%id_type = do_ff_undef
250         impr_kind_set(ikind)%k = 0.0_dp
251         impr_kind_set(ikind)%phi0 = 0.0_dp
252         impr_kind_set(ikind)%kind_number = ikind
253      END DO
254   END SUBROUTINE allocate_impr_kind_set
255
256! **************************************************************************************************
257!> \brief Allocate and initialize a opbend kind set.
258!> \param opbend_kind_set ...
259!> \param nkind ...
260! **************************************************************************************************
261   SUBROUTINE allocate_opbend_kind_set(opbend_kind_set, nkind)
262
263      TYPE(opbend_kind_type), DIMENSION(:), POINTER      :: opbend_kind_set
264      INTEGER, INTENT(IN)                                :: nkind
265
266      CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_opbend_kind_set', &
267         routineP = moduleN//':'//routineN
268
269      INTEGER                                            :: ikind
270
271      NULLIFY (opbend_kind_set)
272      ALLOCATE (opbend_kind_set(nkind))
273      DO ikind = 1, nkind
274         opbend_kind_set(ikind)%id_type = do_ff_undef
275         opbend_kind_set(ikind)%k = 0.0_dp
276         opbend_kind_set(ikind)%phi0 = 0.0_dp
277         opbend_kind_set(ikind)%kind_number = ikind
278      END DO
279   END SUBROUTINE allocate_opbend_kind_set
280
281! **************************************************************************************************
282!> \brief Deallocate a bend kind set.
283!> \param bend_kind_set ...
284! **************************************************************************************************
285   SUBROUTINE deallocate_bend_kind_set(bend_kind_set)
286
287      TYPE(bend_kind_type), DIMENSION(:), POINTER        :: bend_kind_set
288
289      CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_bend_kind_set', &
290         routineP = moduleN//':'//routineN
291
292      INTEGER                                            :: i
293
294      IF (.NOT. ASSOCIATED(bend_kind_set)) RETURN
295      DO i = 1, SIZE(bend_kind_set)
296         IF (ASSOCIATED(bend_kind_set(i)%legendre%coeffs)) THEN
297            DEALLOCATE (bend_kind_set(i)%legendre%coeffs)
298            NULLIFY (bend_kind_set(i)%legendre%coeffs)
299         END IF
300      END DO
301      DEALLOCATE (bend_kind_set)
302   END SUBROUTINE deallocate_bend_kind_set
303
304! **************************************************************************************************
305!> \brief Deallocate a bond kind set.
306!> \param bond_kind_set ...
307! **************************************************************************************************
308   SUBROUTINE deallocate_bond_kind_set(bond_kind_set)
309
310      TYPE(bond_kind_type), DIMENSION(:), POINTER        :: bond_kind_set
311
312      CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_bond_kind_set', &
313         routineP = moduleN//':'//routineN
314
315      DEALLOCATE (bond_kind_set)
316
317   END SUBROUTINE deallocate_bond_kind_set
318
319! **************************************************************************************************
320!> \brief Deallocate a torsion kind element
321!> \param torsion_kind ...
322! **************************************************************************************************
323   SUBROUTINE torsion_kind_dealloc_ref(torsion_kind)
324
325      TYPE(torsion_kind_type), INTENT(INOUT)             :: torsion_kind
326
327      CHARACTER(len=*), PARAMETER :: routineN = 'torsion_kind_dealloc_ref', &
328         routineP = moduleN//':'//routineN
329
330      IF (ASSOCIATED(torsion_kind%k)) THEN
331         DEALLOCATE (torsion_kind%k)
332      END IF
333      IF (ASSOCIATED(torsion_kind%m)) THEN
334         DEALLOCATE (torsion_kind%m)
335      END IF
336      IF (ASSOCIATED(torsion_kind%phi0)) THEN
337         DEALLOCATE (torsion_kind%phi0)
338      END IF
339
340   END SUBROUTINE torsion_kind_dealloc_ref
341
342! **************************************************************************************************
343!> \brief Deallocate a ub kind set.
344!> \param ub_kind_set ...
345! **************************************************************************************************
346   SUBROUTINE ub_kind_dealloc_ref(ub_kind_set)
347      TYPE(ub_kind_type), DIMENSION(:), POINTER          :: ub_kind_set
348
349      CHARACTER(len=*), PARAMETER :: routineN = 'ub_kind_dealloc_ref', &
350         routineP = moduleN//':'//routineN
351
352      DEALLOCATE (ub_kind_set)
353
354   END SUBROUTINE ub_kind_dealloc_ref
355
356! **************************************************************************************************
357!> \brief Deallocate a impr kind element
358! **************************************************************************************************
359   SUBROUTINE impr_kind_dealloc_ref()
360
361      CHARACTER(len=*), PARAMETER :: routineN = 'impr_kind_dealloc_ref', &
362         routineP = moduleN//':'//routineN
363
364!
365! Questa e' la migliore routine che mente umana abbia concepito! ;-)
366! Translation to english: This is the best subroutine that humanity can imagine! ;-)
367!
368
369   END SUBROUTINE impr_kind_dealloc_ref
370
371END MODULE force_field_kind_types
372