Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief The types needed for the calculation of Hirshfeld charges and
10 : !> related functions
11 : !> \par History
12 : !> 11.2014 created [JGH]
13 : !> \author JGH
14 : ! **************************************************************************************************
15 : MODULE hirshfeld_types
16 :
17 : USE input_constants, ONLY: radius_default,&
18 : shape_function_gaussian
19 : USE kinds, ONLY: dp
20 : USE pw_types, ONLY: pw_r3d_rs_type
21 : #include "./base/base_uses.f90"
22 :
23 : IMPLICIT NONE
24 : PRIVATE
25 :
26 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hirshfeld_types'
27 :
28 : PUBLIC :: hirshfeld_type
29 : PUBLIC :: create_hirshfeld_type, release_hirshfeld_type
30 : PUBLIC :: get_hirshfeld_info, set_hirshfeld_info
31 :
32 : ! **************************************************************************************************
33 : !> \brief quantities needed for a Hirshfeld based partitioning of real space
34 : !> \author JGH
35 : ! **************************************************************************************************
36 : TYPE hirshfeld_type
37 : LOGICAL :: iterative = .FALSE., &
38 : use_bohr = .FALSE.
39 : INTEGER :: shape_function_type = -1
40 : INTEGER :: ref_charge = -1, &
41 : radius_type = -1
42 : TYPE(shape_fn), DIMENSION(:), &
43 : POINTER :: kind_shape_fn => NULL()
44 : REAL(KIND=dp), DIMENSION(:), &
45 : POINTER :: charges => NULL()
46 : TYPE(pw_r3d_rs_type), POINTER :: fnorm => NULL()
47 : END TYPE hirshfeld_type
48 :
49 : TYPE shape_fn
50 : INTEGER :: numexp = -1
51 : REAL(KIND=dp), DIMENSION(:), &
52 : POINTER :: zet => NULL()
53 : REAL(KIND=dp), DIMENSION(:), &
54 : POINTER :: coef => NULL()
55 : END TYPE shape_fn
56 :
57 : ! **************************************************************************************************
58 :
59 : CONTAINS
60 :
61 : ! **************************************************************************************************
62 : !> \brief ...
63 : !> \param hirshfeld_env ...
64 : ! **************************************************************************************************
65 4792 : SUBROUTINE create_hirshfeld_type(hirshfeld_env)
66 : TYPE(hirshfeld_type), POINTER :: hirshfeld_env
67 :
68 4792 : IF (ASSOCIATED(hirshfeld_env)) THEN
69 0 : CALL release_hirshfeld_type(hirshfeld_env)
70 : END IF
71 :
72 4792 : ALLOCATE (hirshfeld_env)
73 :
74 : hirshfeld_env%iterative = .FALSE.
75 : hirshfeld_env%use_bohr = .FALSE.
76 4792 : hirshfeld_env%shape_function_type = shape_function_gaussian
77 4792 : hirshfeld_env%radius_type = radius_default
78 : NULLIFY (hirshfeld_env%kind_shape_fn)
79 : NULLIFY (hirshfeld_env%charges)
80 : NULLIFY (hirshfeld_env%fnorm)
81 :
82 4792 : END SUBROUTINE create_hirshfeld_type
83 :
84 : ! **************************************************************************************************
85 : !> \brief ...
86 : !> \param hirshfeld_env ...
87 : ! **************************************************************************************************
88 11434 : SUBROUTINE release_hirshfeld_type(hirshfeld_env)
89 : TYPE(hirshfeld_type), POINTER :: hirshfeld_env
90 :
91 : INTEGER :: ikind
92 11434 : TYPE(shape_fn), DIMENSION(:), POINTER :: kind_shape
93 :
94 11434 : IF (ASSOCIATED(hirshfeld_env)) THEN
95 :
96 4792 : IF (ASSOCIATED(hirshfeld_env%kind_shape_fn)) THEN
97 4702 : kind_shape => hirshfeld_env%kind_shape_fn
98 12872 : DO ikind = 1, SIZE(kind_shape)
99 8170 : IF (ASSOCIATED(hirshfeld_env%kind_shape_fn(ikind)%zet)) THEN
100 8170 : DEALLOCATE (kind_shape(ikind)%zet)
101 : END IF
102 12872 : IF (ASSOCIATED(hirshfeld_env%kind_shape_fn(ikind)%coef)) THEN
103 8170 : DEALLOCATE (kind_shape(ikind)%coef)
104 : END IF
105 : END DO
106 4702 : DEALLOCATE (kind_shape)
107 : END IF
108 :
109 4792 : IF (ASSOCIATED(hirshfeld_env%charges)) THEN
110 4542 : DEALLOCATE (hirshfeld_env%charges)
111 : END IF
112 :
113 4792 : IF (ASSOCIATED(hirshfeld_env%fnorm)) THEN
114 4520 : CALL hirshfeld_env%fnorm%release()
115 4520 : DEALLOCATE (hirshfeld_env%fnorm)
116 : END IF
117 :
118 4792 : DEALLOCATE (hirshfeld_env)
119 :
120 : END IF
121 :
122 11434 : END SUBROUTINE release_hirshfeld_type
123 :
124 : ! **************************************************************************************************
125 : !> \brief Get information from a Hirshfeld env
126 : !> \param hirshfeld_env the env that holds the information
127 : !> \param shape_function_type the type of shape function used
128 : !> \param iterative logical which determines if iterative Hirshfeld charges should be computed
129 : !> \param ref_charge the reference charge type (core charge or mulliken)
130 : !> \param fnorm normalization of the shape function
131 : !> \param radius_type the type of radius used for building the shape functions
132 : !> \param use_bohr logical which determines if angstrom or bohr units are used to build the
133 : !> shape functions
134 : ! **************************************************************************************************
135 4628 : SUBROUTINE get_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, &
136 : ref_charge, fnorm, radius_type, use_bohr)
137 : TYPE(hirshfeld_type), POINTER :: hirshfeld_env
138 : INTEGER, INTENT(OUT), OPTIONAL :: shape_function_type
139 : LOGICAL, INTENT(OUT), OPTIONAL :: iterative
140 : INTEGER, INTENT(OUT), OPTIONAL :: ref_charge
141 : TYPE(pw_r3d_rs_type), OPTIONAL, POINTER :: fnorm
142 : INTEGER, INTENT(OUT), OPTIONAL :: radius_type
143 : LOGICAL, INTENT(OUT), OPTIONAL :: use_bohr
144 :
145 4628 : CPASSERT(ASSOCIATED(hirshfeld_env))
146 :
147 4628 : IF (PRESENT(shape_function_type)) THEN
148 0 : shape_function_type = hirshfeld_env%shape_function_type
149 : END IF
150 4628 : IF (PRESENT(iterative)) THEN
151 0 : iterative = hirshfeld_env%iterative
152 : END IF
153 4628 : IF (PRESENT(use_bohr)) THEN
154 0 : use_bohr = hirshfeld_env%use_bohr
155 : END IF
156 4628 : IF (PRESENT(radius_type)) THEN
157 0 : radius_type = hirshfeld_env%radius_type
158 : END IF
159 4628 : IF (PRESENT(ref_charge)) THEN
160 0 : ref_charge = hirshfeld_env%ref_charge
161 : END IF
162 4628 : IF (PRESENT(fnorm)) THEN
163 4628 : fnorm => hirshfeld_env%fnorm
164 : END IF
165 :
166 4628 : END SUBROUTINE get_hirshfeld_info
167 :
168 : ! **************************************************************************************************
169 : !> \brief Set values of a Hirshfeld env
170 : !> \param hirshfeld_env the env that holds the information
171 : !> \param shape_function_type the type of shape function used
172 : !> \param iterative logical which determines if iterative Hirshfeld charges should be computed
173 : !> \param ref_charge the reference charge type (core charge or mulliken)
174 : !> \param fnorm normalization of the shape function
175 : !> \param radius_type the type of radius used for building the shape functions
176 : !> \param use_bohr logical which determines if angstrom or bohr units are used to build the
177 : !> shape functions
178 : ! **************************************************************************************************
179 9420 : SUBROUTINE set_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, &
180 : ref_charge, fnorm, radius_type, use_bohr)
181 : TYPE(hirshfeld_type), POINTER :: hirshfeld_env
182 : INTEGER, INTENT(IN), OPTIONAL :: shape_function_type
183 : LOGICAL, INTENT(IN), OPTIONAL :: iterative
184 : INTEGER, INTENT(IN), OPTIONAL :: ref_charge
185 : TYPE(pw_r3d_rs_type), OPTIONAL, POINTER :: fnorm
186 : INTEGER, INTENT(IN), OPTIONAL :: radius_type
187 : LOGICAL, INTENT(IN), OPTIONAL :: use_bohr
188 :
189 9420 : CPASSERT(ASSOCIATED(hirshfeld_env))
190 :
191 9420 : IF (PRESENT(shape_function_type)) THEN
192 4792 : hirshfeld_env%shape_function_type = shape_function_type
193 : END IF
194 9420 : IF (PRESENT(iterative)) THEN
195 4792 : hirshfeld_env%iterative = iterative
196 : END IF
197 9420 : IF (PRESENT(use_bohr)) THEN
198 272 : hirshfeld_env%use_bohr = use_bohr
199 : END IF
200 9420 : IF (PRESENT(radius_type)) THEN
201 4792 : hirshfeld_env%radius_type = radius_type
202 : END IF
203 9420 : IF (PRESENT(ref_charge)) THEN
204 4520 : hirshfeld_env%ref_charge = ref_charge
205 : END IF
206 9420 : IF (PRESENT(fnorm)) THEN
207 4628 : hirshfeld_env%fnorm => fnorm
208 : END IF
209 :
210 9420 : END SUBROUTINE set_hirshfeld_info
211 : ! **************************************************************************************************
212 :
213 0 : END MODULE hirshfeld_types
|