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 to store integrals for semi-empirical calculations
8!> \author Teodoro Laino [tlaino] - University of Zurich
9!> \date   05.2008
10! **************************************************************************************************
11MODULE semi_empirical_store_int_types
12
13   USE hfx_compression_methods,         ONLY: hfx_decompress_first_cache,&
14                                              hfx_flush_last_cache,&
15                                              hfx_reset_cache_and_container
16   USE hfx_types,                       ONLY: hfx_cache_type,&
17                                              hfx_container_type,&
18                                              hfx_init_container,&
19                                              hfx_memory_type,&
20                                              parse_memory_section
21   USE input_section_types,             ONLY: section_vals_get_subs_vals,&
22                                              section_vals_type,&
23                                              section_vals_val_get
24   USE kinds,                           ONLY: dp
25   USE memory_utilities,                ONLY: reallocate
26#include "./base/base_uses.f90"
27
28   IMPLICIT NONE
29
30   PRIVATE
31
32! *** Global parameters ***
33
34   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'semi_empirical_store_int_types'
35
36! **************************************************************************************************
37!> \brief Semi-empirical store integrals type
38!> \author Teodoro Laino [tlaino] - University of Zurich
39!> \date   05.2008
40! **************************************************************************************************
41   TYPE semi_empirical_si_type
42      LOGICAL                                     :: filling_containers, compress
43      INTEGER                                     :: nbuffer
44      REAL(KIND=dp), POINTER, DIMENSION(:)        :: max_val_buffer, uncompressed_container
45      TYPE(hfx_memory_type)                       :: memory_parameter
46      TYPE(hfx_cache_type), DIMENSION(:), &
47         POINTER                                :: integral_caches
48      TYPE(hfx_container_type), DIMENSION(:), &
49         POINTER                                :: integral_containers
50   END TYPE semi_empirical_si_type
51
52   PUBLIC :: semi_empirical_si_type, &
53             semi_empirical_si_create, &
54             semi_empirical_si_release, &
55             semi_empirical_si_finalize, &
56             semi_empirical_si_initialize
57
58CONTAINS
59
60! **************************************************************************************************
61!> \brief Allocate semi-empirical store integrals type
62!> \param store_int_env ...
63!> \param se_section ...
64!> \param compression ...
65!> \date   05.2008
66!> \author Teodoro Laino [tlaino] - University of Zurich
67! **************************************************************************************************
68   SUBROUTINE semi_empirical_si_create(store_int_env, se_section, compression)
69      TYPE(semi_empirical_si_type), POINTER              :: store_int_env
70      TYPE(section_vals_type), POINTER                   :: se_section
71      LOGICAL, INTENT(in), OPTIONAL                      :: compression
72
73      CHARACTER(len=*), PARAMETER :: routineN = 'semi_empirical_si_create', &
74         routineP = moduleN//':'//routineN
75
76      INTEGER                                            :: i
77      TYPE(section_vals_type), POINTER                   :: se_mem_section
78
79      CPASSERT(.NOT. ASSOCIATED(store_int_env))
80      ALLOCATE (store_int_env)
81      store_int_env%filling_containers = .TRUE.
82      store_int_env%nbuffer = 0
83      NULLIFY (store_int_env%max_val_buffer, store_int_env%uncompressed_container)
84
85      ! Memory section
86      se_mem_section => section_vals_get_subs_vals(se_section, "MEMORY")
87      IF (PRESENT(compression)) THEN
88         store_int_env%compress = compression
89      ELSE
90         CALL section_vals_val_get(se_mem_section, "COMPRESS", l_val=store_int_env%compress)
91      END IF
92      CALL parse_memory_section(store_int_env%memory_parameter, se_mem_section, skip_disk=.TRUE., &
93                                skip_in_core_forces=.TRUE.)
94      store_int_env%memory_parameter%ram_counter = 0
95      ! If we don't compress there's no cache
96      IF (.NOT. store_int_env%compress) THEN
97         store_int_env%memory_parameter%cache_size = 1
98      END IF
99
100      ! Disk Storage disabled for semi-empirical methods
101      IF (store_int_env%memory_parameter%do_disk_storage) &
102         CPABORT("Disk storage for SEMIEMPIRICAL methods disabled! ")
103
104      ! Allocate containers/caches for integral storage if requested
105      IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly .AND. store_int_env%compress) THEN
106         ALLOCATE (store_int_env%integral_containers(64))
107         ALLOCATE (store_int_env%integral_caches(64))
108         DO i = 1, 64
109            store_int_env%integral_caches(i)%element_counter = 1
110            store_int_env%integral_caches(i)%data = 0
111            ALLOCATE (store_int_env%integral_containers(i)%first)
112            store_int_env%integral_containers(i)%first%prev => NULL()
113            store_int_env%integral_containers(i)%first%next => NULL()
114            store_int_env%integral_containers(i)%current => store_int_env%integral_containers(i)%first
115            store_int_env%integral_containers(i)%current%data = 0
116            store_int_env%integral_containers(i)%element_counter = 1
117         END DO
118      END IF
119   END SUBROUTINE semi_empirical_si_create
120
121! **************************************************************************************************
122!> \brief Deallocate the semi-empirical store integrals type
123!> \param store_int_env ...
124!> \date   05.2008
125!> \author Teodoro Laino [tlaino] - University of Zurich
126! **************************************************************************************************
127   SUBROUTINE semi_empirical_si_release(store_int_env)
128      TYPE(semi_empirical_si_type), POINTER              :: store_int_env
129
130      CHARACTER(len=*), PARAMETER :: routineN = 'semi_empirical_si_release', &
131         routineP = moduleN//':'//routineN
132
133      INTEGER                                            :: i
134
135      IF (ASSOCIATED(store_int_env)) THEN
136         ! Deallocate containers/caches
137         IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly) THEN
138            IF (store_int_env%compress) THEN
139               ! Deallocate containers/caches
140               DO i = 1, 64
141                  CALL hfx_init_container(store_int_env%integral_containers(i), &
142                                          store_int_env%memory_parameter%actual_memory_usage, &
143                                          .FALSE.)
144                  DEALLOCATE (store_int_env%integral_containers(i)%first)
145               END DO
146               IF (ASSOCIATED(store_int_env%max_val_buffer)) THEN
147                  DEALLOCATE (store_int_env%max_val_buffer)
148               END IF
149               DEALLOCATE (store_int_env%integral_containers)
150               DEALLOCATE (store_int_env%integral_caches)
151            ELSE
152               IF (ASSOCIATED(store_int_env%uncompressed_container)) THEN
153                  DEALLOCATE (store_int_env%uncompressed_container)
154               END IF
155            END IF
156         END IF
157         ! Deallocate the full store_int_env
158         DEALLOCATE (store_int_env)
159      END IF
160
161   END SUBROUTINE semi_empirical_si_release
162
163! **************************************************************************************************
164!> \brief Deallocate the semi-empirical store integrals type
165!> \param store_int_env ...
166!> \param geometry_did_change ...
167!> \date   05.2008
168!> \author Teodoro Laino [tlaino] - University of Zurich
169! **************************************************************************************************
170   SUBROUTINE semi_empirical_si_initialize(store_int_env, geometry_did_change)
171      TYPE(semi_empirical_si_type), POINTER              :: store_int_env
172      LOGICAL, INTENT(IN)                                :: geometry_did_change
173
174      CHARACTER(len=*), PARAMETER :: routineN = 'semi_empirical_si_initialize', &
175         routineP = moduleN//':'//routineN
176
177      INTEGER                                            :: i
178
179      IF (ASSOCIATED(store_int_env)) THEN
180         IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly) THEN
181            IF (geometry_did_change) THEN
182               store_int_env%filling_containers = .TRUE.
183               store_int_env%nbuffer = 0
184               store_int_env%memory_parameter%ram_counter = HUGE(store_int_env%memory_parameter%ram_counter)
185               IF (store_int_env%compress) THEN
186                  ! Compress integrals
187                  CALL reallocate(store_int_env%max_val_buffer, 1, store_int_env%nbuffer)
188                  ! Clean containers
189                  DO i = 1, 64
190                     CALL hfx_init_container(store_int_env%integral_containers(i), &
191                                             store_int_env%memory_parameter%actual_memory_usage, &
192                                             .FALSE.)
193                  END DO
194               ELSE
195                  ! Skip compression
196                  CALL reallocate(store_int_env%uncompressed_container, 1, 0)
197                  store_int_env%memory_parameter%actual_memory_usage = 1
198               END IF
199            ELSE
200               store_int_env%filling_containers = .FALSE.
201               store_int_env%nbuffer = 0
202               IF (store_int_env%compress) THEN
203                  ! Retrieve data into the cache
204                  DO i = 1, 64
205                     CALL hfx_decompress_first_cache(i, store_int_env%integral_caches(i), &
206                                                     store_int_env%integral_containers(i), &
207                                                     store_int_env%memory_parameter%actual_memory_usage, .FALSE.)
208                  END DO
209               ELSE
210                  store_int_env%memory_parameter%actual_memory_usage = 1
211               END IF
212            END IF
213         END IF
214      END IF
215
216   END SUBROUTINE semi_empirical_si_initialize
217
218! **************************************************************************************************
219!> \brief Deallocate the semi-empirical store integrals type
220!> \param store_int_env ...
221!> \param geometry_did_change ...
222!> \date   05.2008
223!> \author Teodoro Laino [tlaino] - University of Zurich
224! **************************************************************************************************
225   SUBROUTINE semi_empirical_si_finalize(store_int_env, geometry_did_change)
226      TYPE(semi_empirical_si_type), POINTER              :: store_int_env
227      LOGICAL, INTENT(IN)                                :: geometry_did_change
228
229      CHARACTER(len=*), PARAMETER :: routineN = 'semi_empirical_si_finalize', &
230         routineP = moduleN//':'//routineN
231
232      INTEGER                                            :: i
233
234      IF (ASSOCIATED(store_int_env)) THEN
235         IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly) THEN
236            IF (geometry_did_change) THEN
237               IF (store_int_env%compress) THEN
238                  ! Flush last cache
239                  DO i = 1, 64
240                     CALL hfx_flush_last_cache(i, store_int_env%integral_caches(i), &
241                                               store_int_env%integral_containers(i), &
242                                               store_int_env%memory_parameter%actual_memory_usage, .FALSE.)
243                  END DO
244                  ! Reallocate this array with the proper size
245                  CALL reallocate(store_int_env%max_val_buffer, 1, store_int_env%nbuffer)
246               ELSE
247                  ! Skip compression
248                  CALL reallocate(store_int_env%uncompressed_container, 1, &
249                                  store_int_env%memory_parameter%actual_memory_usage - 1)
250               END IF
251            END IF
252            IF (store_int_env%compress) THEN
253               ! Reset caches and containers
254               DO i = 1, 64
255                  CALL hfx_reset_cache_and_container( &
256                     store_int_env%integral_caches(i), &
257                     store_int_env%integral_containers(i), store_int_env%memory_parameter%actual_memory_usage, &
258                     .FALSE.)
259               END DO
260            END IF
261         END IF
262      END IF
263
264   END SUBROUTINE semi_empirical_si_finalize
265
266END MODULE semi_empirical_store_int_types
267