1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief Types needed for a for a Energy Correction
8!> \par History
9!>       2019.09 created
10!> \author JGH
11! **************************************************************************************************
12MODULE ec_env_types
13   USE cp_dbcsr_operations,             ONLY: dbcsr_deallocate_matrix_set
14   USE cp_fm_types,                     ONLY: cp_fm_p_type,&
15                                              cp_fm_release
16   USE dbcsr_api,                       ONLY: dbcsr_p_type
17   USE input_section_types,             ONLY: section_vals_type
18   USE kinds,                           ONLY: dp
19   USE pw_types,                        ONLY: pw_p_type,&
20                                              pw_release
21   USE qs_dispersion_types,             ONLY: qs_dispersion_release,&
22                                              qs_dispersion_type
23   USE qs_force_types,                  ONLY: deallocate_qs_force,&
24                                              qs_force_type
25   USE qs_neighbor_list_types,          ONLY: neighbor_list_set_p_type,&
26                                              release_neighbor_list_sets
27   USE qs_p_env_types,                  ONLY: p_env_release,&
28                                              qs_p_env_type
29   USE qs_period_efield_types,          ONLY: efield_berry_release,&
30                                              efield_berry_type
31   USE task_list_types,                 ONLY: deallocate_task_list,&
32                                              task_list_type
33#include "./base/base_uses.f90"
34
35   IMPLICIT NONE
36
37   PRIVATE
38
39   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ec_env_types'
40
41   PUBLIC :: energy_correction_type, ec_env_release
42
43! *****************************************************************************
44!> \brief Contains information on the energy correction functional for KG
45!> \par History
46!>       03.2014 created
47!> \author JGH
48! *****************************************************************************
49   TYPE energy_correction_type
50      CHARACTER(len=20)                                :: ec_name
51      INTEGER                                          :: energy_functional
52      INTEGER                                          :: ks_solver
53      INTEGER                                          :: factorization
54      REAL(KIND=dp)                                    :: eps_default
55      LOGICAL                                          :: should_update
56      ! basis set
57      CHARACTER(len=20)                                :: basis
58      LOGICAL                                          :: mao
59      INTEGER                                          :: mao_max_iter
60      REAL(KIND=dp)                                    :: mao_eps_grad
61      ! energy components
62      REAL(KIND=dp)                                    :: etotal
63      REAL(KIND=dp)                                    :: eband, exc, ehartree, vhxc
64      REAL(KIND=dp)                                    :: edispersion, efield_nuclear
65      ! forces
66      TYPE(qs_force_type), DIMENSION(:), POINTER       :: force => Null()
67      ! full neighbor lists and corresponding task list
68      TYPE(neighbor_list_set_p_type), &
69         DIMENSION(:), POINTER                         :: sab_orb, sac_ppl, sap_ppnl
70      TYPE(task_list_type), POINTER                    :: task_list
71      ! the XC function to be used for the correction, dispersion info
72      TYPE(section_vals_type), POINTER                 :: xc_section
73      TYPE(qs_dispersion_type), POINTER                :: dispersion_env
74      ! matrices in complete basis
75      ! KS: Kohn-Sham; H: Core; S: overlap; T: kinetic energy;
76      TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER     :: matrix_ks
77      TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER     :: matrix_h
78      TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER     :: matrix_s
79      TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER     :: matrix_t
80      TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER     :: matrix_p
81      TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER     :: matrix_w
82      ! reduce basis
83      TYPE(dbcsr_p_type), DIMENSION(:), POINTER        :: mao_coef
84      ! CP equations
85      TYPE(qs_p_env_type), POINTER                     :: p_env
86      TYPE(cp_fm_p_type), DIMENSION(:), POINTER        :: cpmos
87      TYPE(dbcsr_p_type), DIMENSION(:), POINTER        :: matrix_hz
88      ! potentials from input density
89      TYPE(pw_p_type), POINTER                         :: vh_rspace
90      TYPE(pw_p_type), DIMENSION(:), POINTER           :: vxc_rspace, vtau_rspace
91      ! efield
92      TYPE(efield_berry_type), POINTER                 :: efield => NULL()
93   END TYPE energy_correction_type
94
95CONTAINS
96
97! **************************************************************************************************
98!> \brief ...
99!> \param ec_env ...
100! **************************************************************************************************
101   SUBROUTINE ec_env_release(ec_env)
102      TYPE(energy_correction_type), POINTER              :: ec_env
103
104      CHARACTER(LEN=*), PARAMETER :: routineN = 'ec_env_release', routineP = moduleN//':'//routineN
105
106      INTEGER                                            :: handle, iab
107
108      CALL timeset(routineN, handle)
109
110      IF (ASSOCIATED(ec_env)) THEN
111         ! neighbor lists
112         CALL release_neighbor_list_sets(ec_env%sab_orb)
113         CALL release_neighbor_list_sets(ec_env%sac_ppl)
114         CALL release_neighbor_list_sets(ec_env%sap_ppnl)
115         ! forces
116         IF (ASSOCIATED(ec_env%force)) CALL deallocate_qs_force(ec_env%force)
117         ! operator matrices
118         IF (ASSOCIATED(ec_env%matrix_ks)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_ks)
119         IF (ASSOCIATED(ec_env%matrix_h)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_h)
120         IF (ASSOCIATED(ec_env%matrix_s)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_s)
121         IF (ASSOCIATED(ec_env%matrix_t)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_t)
122         IF (ASSOCIATED(ec_env%matrix_p)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_p)
123         IF (ASSOCIATED(ec_env%matrix_w)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_w)
124         IF (ASSOCIATED(ec_env%task_list)) THEN
125            CALL deallocate_task_list(ec_env%task_list)
126         END IF
127         ! reduced basis
128         IF (ASSOCIATED(ec_env%mao_coef)) CALL dbcsr_deallocate_matrix_set(ec_env%mao_coef)
129         ! dispersion environment
130         IF (ASSOCIATED(ec_env%dispersion_env)) THEN
131            CALL qs_dispersion_release(ec_env%dispersion_env)
132         END IF
133         ! CP env
134         IF (ASSOCIATED(ec_env%cpmos)) THEN
135            DO iab = 1, SIZE(ec_env%cpmos)
136               CALL cp_fm_release(ec_env%cpmos(iab)%matrix)
137            END DO
138            DEALLOCATE (ec_env%cpmos)
139            NULLIFY (ec_env%cpmos)
140         END IF
141
142         IF (ASSOCIATED(ec_env%matrix_hz)) CALL dbcsr_deallocate_matrix_set(ec_env%matrix_hz)
143         NULLIFY (ec_env%matrix_hz)
144
145         IF (ASSOCIATED(ec_env%p_env)) THEN
146            CALL p_env_release(ec_env%p_env)
147         END IF
148         ! potential
149         IF (ASSOCIATED(ec_env%vh_rspace)) THEN
150            CALL pw_release(ec_env%vh_rspace%pw)
151            DEALLOCATE (ec_env%vh_rspace)
152         END IF
153         IF (ASSOCIATED(ec_env%vxc_rspace)) THEN
154            DO iab = 1, SIZE(ec_env%vxc_rspace)
155               CALL pw_release(ec_env%vxc_rspace(iab)%pw)
156            END DO
157            DEALLOCATE (ec_env%vxc_rspace)
158         END IF
159         IF (ASSOCIATED(ec_env%vtau_rspace)) THEN
160            DO iab = 1, SIZE(ec_env%vtau_rspace)
161               CALL pw_release(ec_env%vtau_rspace(iab)%pw)
162            END DO
163            DEALLOCATE (ec_env%vtau_rspace)
164         END IF
165         CALL efield_berry_release(ec_env%efield)
166
167         DEALLOCATE (ec_env)
168
169      END IF
170
171      CALL timestop(handle)
172
173   END SUBROUTINE ec_env_release
174
175END MODULE ec_env_types
176