1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief Type for the canonical sampling through velocity rescaling
8!> \author Teodoro Laino - 09.2007 University of Zurich [tlaino]
9! **************************************************************************************************
10MODULE al_system_types
11   USE bibliography,                    ONLY: Jones2011,&
12                                              cite_reference
13   USE extended_system_types,           ONLY: create_map_info_type,&
14                                              map_info_type,&
15                                              release_map_info_type
16   USE input_section_types,             ONLY: section_vals_type,&
17                                              section_vals_val_get
18   USE kinds,                           ONLY: dp
19   USE simpar_types,                    ONLY: simpar_type
20#include "./base/base_uses.f90"
21
22   IMPLICIT NONE
23
24   PRIVATE
25   PUBLIC :: al_system_type, &
26             al_init, &
27             al_dealloc, &
28             al_thermo_create
29
30! **************************************************************************************************
31   TYPE al_thermo_type
32      INTEGER                                 :: degrees_of_freedom
33      REAL(KIND=dp)                           :: nkt
34      REAL(KIND=dp)                           :: chi
35      REAL(KIND=dp)                           :: mass
36      REAL(KIND=dp)                           :: region_kin_energy
37   END TYPE al_thermo_type
38
39! **************************************************************************************************
40   TYPE al_system_type
41      INTEGER                                 :: region, glob_num_al, loc_num_al
42      REAL(KIND=dp)                           :: tau_nh, tau_langevin, dt_fact
43      REAL(KIND=dp)                           :: dt
44      TYPE(al_thermo_type), POINTER           :: nvt(:)
45      TYPE(map_info_type), POINTER            :: map_info
46   END TYPE al_system_type
47
48! *** Global parameters ***
49   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'al_system_types'
50
51CONTAINS
52
53! **************************************************************************************************
54!> \brief Initialize type for Adaptive Langevin (AD_LANGEVIN)
55!> \param al ...
56!> \param simpar ...
57!> \param section ...
58!> \author Noam Bernstein [noamb] 02.2012
59! **************************************************************************************************
60   SUBROUTINE al_init(al, simpar, section)
61      TYPE(al_system_type), POINTER                      :: al
62      TYPE(simpar_type), POINTER                         :: simpar
63      TYPE(section_vals_type), POINTER                   :: section
64
65      CHARACTER(LEN=*), PARAMETER :: routineN = 'al_init', routineP = moduleN//':'//routineN
66
67      NULLIFY (al%nvt)
68      NULLIFY (al%map_info)
69      al%loc_num_al = 0
70      al%glob_num_al = 0
71      al%dt_fact = 1.0_dp
72      al%dt = simpar%dt
73      CALL cite_reference(Jones2011)
74      CALL section_vals_val_get(section, "TIMECON_NH", r_val=al%tau_nh)
75      CALL section_vals_val_get(section, "TIMECON_LANGEVIN", r_val=al%tau_langevin)
76      CALL create_map_info_type(al%map_info)
77
78   END SUBROUTINE al_init
79
80! **************************************************************************************************
81!> \brief Initialize NVT type for AD_LANGEVIN thermostat
82!> \param al ...
83!> \author Noam Bernstein [noamb]  02.2012
84! **************************************************************************************************
85   SUBROUTINE al_thermo_create(al)
86      TYPE(al_system_type), POINTER                      :: al
87
88      CHARACTER(LEN=*), PARAMETER :: routineN = 'al_thermo_create', &
89         routineP = moduleN//':'//routineN
90
91      INTEGER                                            :: i
92      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :)     :: seed
93
94      CPASSERT(ASSOCIATED(al))
95      CPASSERT(.NOT. ASSOCIATED(al%nvt))
96
97      ALLOCATE (al%nvt(al%loc_num_al))
98      DO i = 1, al%loc_num_al
99         al%nvt(i)%chi = 0.0_dp
100      END DO
101      ! Initialize the gaussian stream random number
102      ALLOCATE (seed(3, 2, al%glob_num_al))
103
104   END SUBROUTINE al_thermo_create
105
106! **************************************************************************************************
107!> \brief Deallocate type for AD_LANGEVIN thermostat
108!> \param al ...
109!> \author Noam Bernstein [noamb] 02.2012
110! **************************************************************************************************
111   SUBROUTINE al_dealloc(al)
112      TYPE(al_system_type), POINTER                      :: al
113
114      CHARACTER(LEN=*), PARAMETER :: routineN = 'al_dealloc', routineP = moduleN//':'//routineN
115
116      IF (ASSOCIATED(al)) THEN
117         CALL al_thermo_dealloc(al%nvt)
118         CALL release_map_info_type(al%map_info)
119         DEALLOCATE (al)
120      ENDIF
121
122   END SUBROUTINE al_dealloc
123
124! **************************************************************************************************
125!> \brief Deallocate NVT type for AD_LANGEVIN thermostat
126!> \param nvt ...
127!> \author Noam Bernstein [noamb] 02.2012
128! **************************************************************************************************
129   SUBROUTINE al_thermo_dealloc(nvt)
130      TYPE(al_thermo_type), DIMENSION(:), POINTER        :: nvt
131
132      CHARACTER(LEN=*), PARAMETER :: routineN = 'al_thermo_dealloc', &
133         routineP = moduleN//':'//routineN
134
135      IF (ASSOCIATED(nvt)) THEN
136         DEALLOCATE (nvt)
137      ENDIF
138   END SUBROUTINE al_thermo_dealloc
139
140END MODULE al_system_types
141
142