1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief Definition and initialisation of the et_coupling data type.
8!> \author Florian Schiffmann (01.2007,fschiff)
9! **************************************************************************************************
10MODULE et_coupling_types
11
12   USE cp_fm_types,                     ONLY: cp_fm_p_type,&
13                                              cp_fm_release
14   USE dbcsr_api,                       ONLY: dbcsr_p_type
15   USE kinds,                           ONLY: dp
16#include "./base/base_uses.f90"
17
18   IMPLICIT NONE
19
20   PRIVATE
21
22   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'et_coupling_types'
23
24! *** Public data types ***
25
26   PUBLIC :: et_coupling_type
27
28! *** Public subroutines ***
29
30   PUBLIC :: et_coupling_create, &
31             et_coupling_release, &
32             set_et_coupling_type
33
34! **************************************************************************************************
35!> \par History
36!>      01.2007 created [Florian Schiffmann]
37!> \author fschiff
38! **************************************************************************************************
39   TYPE et_coupling_type
40      TYPE(cp_fm_p_type), DIMENSION(:), POINTER           :: et_mo_coeff
41      TYPE(dbcsr_p_type), DIMENSION(:), POINTER     :: rest_mat
42      LOGICAL                                            :: first_run
43      LOGICAL                                            :: keep_matrix
44      REAL(KIND=dp)                                    :: energy, e1, order_p
45   END TYPE
46
47CONTAINS
48
49! **************************************************************************************************
50!> \brief ...
51!> \param et_coupling ...
52! **************************************************************************************************
53   SUBROUTINE et_coupling_create(et_coupling)
54      TYPE(et_coupling_type), POINTER                    :: et_coupling
55
56      CHARACTER(len=*), PARAMETER :: routineN = 'et_coupling_create', &
57         routineP = moduleN//':'//routineN
58
59      ALLOCATE (et_coupling)
60
61      NULLIFY (et_coupling%et_mo_coeff)
62      NULLIFY (et_coupling%rest_mat)
63      et_coupling%first_run = .TRUE.
64      et_coupling%keep_matrix = .FALSE.
65      ALLOCATE (et_coupling%rest_mat(2))
66
67   END SUBROUTINE et_coupling_create
68
69! **************************************************************************************************
70!> \brief ...
71!> \param et_coupling ...
72!> \param et_mo_coeff ...
73!> \param rest_mat ...
74! **************************************************************************************************
75   SUBROUTINE get_et_coupling_type(et_coupling, et_mo_coeff, rest_mat)
76      TYPE(et_coupling_type), POINTER                    :: et_coupling
77      TYPE(cp_fm_p_type), DIMENSION(:), OPTIONAL, &
78         POINTER                                         :: et_mo_coeff
79      TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
80         POINTER                                         :: rest_mat
81
82      CHARACTER(len=*), PARAMETER :: routineN = 'get_et_coupling_type', &
83         routineP = moduleN//':'//routineN
84
85      IF (PRESENT(et_mo_coeff)) et_mo_coeff => et_coupling%et_mo_coeff
86      IF (PRESENT(rest_mat)) rest_mat => et_coupling%rest_mat
87
88   END SUBROUTINE get_et_coupling_type
89
90! **************************************************************************************************
91!> \brief ...
92!> \param et_coupling ...
93!> \param et_mo_coeff ...
94!> \param rest_mat ...
95! **************************************************************************************************
96   SUBROUTINE set_et_coupling_type(et_coupling, et_mo_coeff, rest_mat)
97      TYPE(et_coupling_type), POINTER                    :: et_coupling
98      TYPE(cp_fm_p_type), DIMENSION(:), OPTIONAL, &
99         POINTER                                         :: et_mo_coeff
100      TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
101         POINTER                                         :: rest_mat
102
103      CHARACTER(len=*), PARAMETER :: routineN = 'set_et_coupling_type', &
104         routineP = moduleN//':'//routineN
105
106      IF (PRESENT(et_mo_coeff)) et_coupling%et_mo_coeff = et_mo_coeff
107      IF (PRESENT(rest_mat)) et_coupling%rest_mat => rest_mat
108
109   END SUBROUTINE set_et_coupling_type
110
111! **************************************************************************************************
112!> \brief ...
113!> \param et_coupling ...
114! **************************************************************************************************
115   SUBROUTINE et_coupling_release(et_coupling)
116      TYPE(et_coupling_type), POINTER                    :: et_coupling
117
118      CHARACTER(LEN=*), PARAMETER :: routineN = 'et_coupling_release', &
119         routineP = moduleN//':'//routineN
120
121      INTEGER                                            :: i
122
123      IF (ASSOCIATED(et_coupling%et_mo_coeff)) THEN
124         DO i = 1, SIZE(et_coupling%et_mo_coeff)
125            CALL cp_fm_release(et_coupling%et_mo_coeff(i)%matrix)
126         END DO
127         DEALLOCATE (et_coupling%et_mo_coeff)
128      END IF
129      IF (ASSOCIATED(et_coupling%rest_mat)) THEN
130!         CALL deallocate_matrix_set(et_coupling%rest_mat)
131         DEALLOCATE (et_coupling%rest_mat)
132      END IF
133
134      DEALLOCATE (et_coupling)
135   END SUBROUTINE et_coupling_release
136
137END MODULE et_coupling_types
138
139