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 (11.08.2002) exchange and correlation energy now in exc
9!> \author MK (13.06.2002)
10! **************************************************************************************************
11MODULE fist_energy_types
12
13   USE kinds,                           ONLY: dp
14#include "./base/base_uses.f90"
15
16   IMPLICIT NONE
17   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'fist_energy_types'
18
19   PRIVATE
20
21! **************************************************************************************************
22   TYPE fist_energy_type
23      REAL(kind=dp) :: kin, pot, e_gspace, e_self, e_neut, e_bonded, e_induction
24      REAL(kind=dp) :: kin_shell, harm_shell
25   END TYPE fist_energy_type
26
27! *** Public data types ***
28
29   PUBLIC :: fist_energy_type
30
31! *** Public subroutines ***
32
33   PUBLIC :: allocate_fist_energy, &
34             deallocate_fist_energy
35
36CONTAINS
37
38! **************************************************************************************************
39!> \brief   Allocate and/or initialise a Fist energy data structure.
40!> \param fist_energy ...
41!> \date    13.06.2002
42!> \author  MK
43!> \version 1.0
44! **************************************************************************************************
45   SUBROUTINE allocate_fist_energy(fist_energy)
46      TYPE(fist_energy_type), POINTER                    :: fist_energy
47
48      CHARACTER(len=*), PARAMETER :: routineN = 'allocate_fist_energy', &
49         routineP = moduleN//':'//routineN
50
51      IF (.NOT. ASSOCIATED(fist_energy)) THEN
52         ALLOCATE (fist_energy)
53      END IF
54
55      CALL init_fist_energy(fist_energy)
56
57   END SUBROUTINE allocate_fist_energy
58
59! **************************************************************************************************
60!> \brief   Deallocate a Fist energy data structure.
61!> \param fist_energy ...
62!> \date    13.06.2002
63!> \author  MK
64!> \version 1.0
65! **************************************************************************************************
66   SUBROUTINE deallocate_fist_energy(fist_energy)
67      TYPE(fist_energy_type), POINTER                    :: fist_energy
68
69      CHARACTER(len=*), PARAMETER :: routineN = 'deallocate_fist_energy', &
70         routineP = moduleN//':'//routineN
71
72      IF (ASSOCIATED(fist_energy)) THEN
73         DEALLOCATE (fist_energy)
74      ELSE
75         CALL cp_abort(__LOCATION__, &
76                       "The fist_energy pointer is not associated "// &
77                       "and cannot be deallocated.")
78      END IF
79
80   END SUBROUTINE deallocate_fist_energy
81
82! **************************************************************************************************
83!> \brief   Initialise a Fist energy data structure.
84!> \param fist_energy ...
85!> \date    13.06.2002
86!> \author  MK
87!> \version 1.0
88! **************************************************************************************************
89   SUBROUTINE init_fist_energy(fist_energy)
90      TYPE(fist_energy_type), POINTER                    :: fist_energy
91
92      CHARACTER(len=*), PARAMETER :: routineN = 'init_fist_energy', &
93         routineP = moduleN//':'//routineN
94
95      IF (ASSOCIATED(fist_energy)) THEN
96         fist_energy%kin = 0.0_dp
97         fist_energy%pot = 0.0_dp
98         fist_energy%e_gspace = 0.0_dp
99         fist_energy%e_self = 0.0_dp
100         fist_energy%e_neut = 0.0_dp
101         fist_energy%e_bonded = 0.0_dp
102         fist_energy%e_induction = 0.0_dp
103         fist_energy%kin_shell = 0.0_dp
104         fist_energy%harm_shell = 0.0_dp
105      ELSE
106         CALL cp_abort(__LOCATION__, &
107                       "The fist_energy pointer is not associated "// &
108                       "and cannot be initialised.")
109      END IF
110
111   END SUBROUTINE init_fist_energy
112
113END MODULE fist_energy_types
114