1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief Thermal regions type: to initialize and control the temperature of
8!>        different regions
9!> \par History
10!>   - Added support for langevin regions (2014/01/08, LT)
11!> \author MI
12! **************************************************************************************************
13MODULE thermal_region_types
14
15   USE input_section_types,             ONLY: section_vals_type
16   USE kinds,                           ONLY: dp
17#include "../base/base_uses.f90"
18
19   IMPLICIT NONE
20
21   PRIVATE
22   PUBLIC :: thermal_regions_type, &
23             thermal_region_type, &
24             allocate_thermal_regions, &
25             release_thermal_regions, &
26             retain_thermal_regions
27
28   TYPE thermal_regions_type
29      INTEGER :: id_nr, ref_count, nregions
30      LOGICAL :: force_rescaling
31      REAL(KIND=dp) :: temp_reg0
32      LOGICAL, DIMENSION(:), POINTER                   :: do_langevin
33      TYPE(section_vals_type), POINTER                 :: section
34      TYPE(thermal_region_type), DIMENSION(:), POINTER :: thermal_region
35   END TYPE thermal_regions_type
36
37   TYPE thermal_region_type
38      INTEGER :: region_index, npart
39      INTEGER, DIMENSION(:), POINTER :: part_index
40      REAL(KIND=dp) :: ekin, noisy_gamma_region, temperature, temp_expected, temp_tol
41   END TYPE thermal_region_type
42
43   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'thermal_region_types'
44CONTAINS
45
46! **************************************************************************************************
47!> \brief allocate thermal_regions
48!> \param thermal_regions ...
49!> \author
50! **************************************************************************************************
51   SUBROUTINE allocate_thermal_regions(thermal_regions)
52      TYPE(thermal_regions_type), POINTER                :: thermal_regions
53
54      CHARACTER(len=*), PARAMETER :: routineN = 'allocate_thermal_regions', &
55         routineP = moduleN//':'//routineN
56
57      LOGICAL                                            :: check
58
59      check = .NOT. ASSOCIATED(thermal_regions)
60      CPASSERT(check)
61
62      ALLOCATE (thermal_regions)
63      thermal_regions%ref_count = 1
64      thermal_regions%nregions = 0
65      NULLIFY (thermal_regions%thermal_region)
66      NULLIFY (thermal_regions%do_langevin)
67
68   END SUBROUTINE allocate_thermal_regions
69! **************************************************************************************************
70!> \brief retains  thermal_regions
71!> \param thermal_regions ...
72!> \author
73! **************************************************************************************************
74   SUBROUTINE retain_thermal_regions(thermal_regions)
75
76      TYPE(thermal_regions_type), POINTER                :: thermal_regions
77
78      CHARACTER(len=*), PARAMETER :: routineN = 'retain_thermal_regions', &
79         routineP = moduleN//':'//routineN
80
81      IF (ASSOCIATED(thermal_regions)) THEN
82         CPASSERT(thermal_regions%ref_count > 0)
83         thermal_regions%ref_count = thermal_regions%ref_count + 1
84      END IF
85
86   END SUBROUTINE retain_thermal_regions
87
88! **************************************************************************************************
89!> \brief release thermal_regions
90!> \param thermal_regions ...
91!> \author
92! **************************************************************************************************
93   SUBROUTINE release_thermal_regions(thermal_regions)
94
95      TYPE(thermal_regions_type), POINTER                :: thermal_regions
96
97      CHARACTER(len=*), PARAMETER :: routineN = 'release_thermal_regions', &
98         routineP = moduleN//':'//routineN
99
100      INTEGER                                            :: ireg
101      LOGICAL                                            :: check
102
103      check = ASSOCIATED(thermal_regions)
104      IF (check) THEN
105         check = thermal_regions%ref_count > 0
106         CPASSERT(check)
107         thermal_regions%ref_count = thermal_regions%ref_count - 1
108         IF (thermal_regions%ref_count < 1) THEN
109            IF (ASSOCIATED(thermal_regions%thermal_region)) THEN
110               DO ireg = 1, SIZE(thermal_regions%thermal_region)
111                  DEALLOCATE (thermal_regions%thermal_region(ireg)%part_index)
112               END DO
113               DEALLOCATE (thermal_regions%thermal_region)
114            END IF
115            IF (ASSOCIATED(thermal_regions%do_langevin)) THEN
116               DEALLOCATE (thermal_regions%do_langevin)
117            END IF
118            DEALLOCATE (thermal_regions)
119         END IF
120      END IF
121
122   END SUBROUTINE release_thermal_regions
123
124END MODULE thermal_region_types
125