Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \par History
10 : !> - Container to hold basis sets
11 : !> \author JGH (09.07.2015)
12 : ! **************************************************************************************************
13 : MODULE basis_set_container_types
14 :
15 : USE basis_set_types, ONLY: deallocate_gto_basis_set,&
16 : gto_basis_set_type
17 : USE kinds, ONLY: default_string_length
18 : #include "../base/base_uses.f90"
19 :
20 : IMPLICIT NONE
21 :
22 : PRIVATE
23 :
24 : ! Global parameters (only in this module)
25 :
26 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'basis_set_container_types'
27 :
28 : ! **************************************************************************************************
29 : INTEGER, PARAMETER :: unknown_basis = 100, &
30 : orbital_basis = 101, &
31 : auxiliary_basis = 102, &
32 : ri_aux_basis = 103, &
33 : lri_aux_basis = 104, &
34 : aux_fit_basis = 105, &
35 : soft_basis = 106, &
36 : gapw_1c_basis = 107, &
37 : mao_basis = 108, &
38 : harris_basis = 109, &
39 : aux_gw_basis = 110, &
40 : ri_hxc_basis = 111, &
41 : ri_k_basis = 112, &
42 : ri_xas_basis = 113, &
43 : aux_fit_soft_basis = 114, &
44 : ri_hfx_basis = 115, &
45 : p_lri_aux_basis = 116, &
46 : aux_opt_basis = 117, &
47 : min_basis = 118, &
48 : tda_k_basis = 119, &
49 : rhoin_basis = 120, &
50 : nuclear_basis = 121, &
51 : nuclear_soft_basis = 122, &
52 : harris_soft_basis = 123
53 : ! **************************************************************************************************
54 : TYPE basis_set_container_type
55 : PRIVATE
56 : CHARACTER(LEN=default_string_length) :: basis_type = ""
57 : INTEGER :: basis_type_nr = 0
58 : TYPE(gto_basis_set_type), POINTER :: basis_set => NULL()
59 : END TYPE basis_set_container_type
60 : ! **************************************************************************************************
61 :
62 : PUBLIC :: basis_set_container_type
63 :
64 : PUBLIC :: remove_basis_set_container, &
65 : add_basis_set_to_container, get_basis_from_container, &
66 : remove_basis_from_container
67 :
68 : ! **************************************************************************************************
69 :
70 : CONTAINS
71 :
72 : ! **************************************************************************************************
73 : !> \brief ...
74 : !> \param basis ...
75 : ! **************************************************************************************************
76 16517 : SUBROUTINE remove_basis_set_container(basis)
77 : TYPE(basis_set_container_type), DIMENSION(:), &
78 : INTENT(inout) :: basis
79 :
80 : INTEGER :: i
81 :
82 346857 : DO i = 1, SIZE(basis)
83 330340 : basis(i)%basis_type = ""
84 330340 : basis(i)%basis_type_nr = 0
85 346857 : IF (ASSOCIATED(basis(i)%basis_set)) THEN
86 24682 : CALL deallocate_gto_basis_set(basis(i)%basis_set)
87 : END IF
88 : END DO
89 :
90 16517 : END SUBROUTINE remove_basis_set_container
91 :
92 : ! **************************************************************************************************
93 : !> \brief ...
94 : !> \param basis_set_type ...
95 : !> \return ...
96 : ! **************************************************************************************************
97 20861935 : FUNCTION get_basis_type(basis_set_type) RESULT(basis_type_nr)
98 : CHARACTER(len=*) :: basis_set_type
99 : INTEGER :: basis_type_nr
100 :
101 : SELECT CASE (basis_set_type)
102 : CASE ("ORB")
103 146609 : basis_type_nr = orbital_basis
104 : CASE ("AUX")
105 146609 : basis_type_nr = auxiliary_basis
106 : CASE ("MIN")
107 20800 : basis_type_nr = min_basis
108 : CASE ("RI_AUX")
109 7507206 : basis_type_nr = ri_aux_basis
110 : CASE ("RI_HXC")
111 93202 : basis_type_nr = ri_hxc_basis
112 : CASE ("RI_HFX")
113 16500 : basis_type_nr = ri_hfx_basis
114 : CASE ("RI_K")
115 64552 : basis_type_nr = ri_k_basis
116 : CASE ("LRI_AUX")
117 99371 : basis_type_nr = lri_aux_basis
118 : CASE ("P_LRI_AUX")
119 21554 : basis_type_nr = p_lri_aux_basis
120 : CASE ("AUX_FIT")
121 220304 : basis_type_nr = aux_fit_basis
122 : CASE ("AUX_FIT_SOFT")
123 10288 : basis_type_nr = aux_fit_soft_basis
124 : CASE ("ORB_SOFT")
125 52370 : basis_type_nr = soft_basis
126 : CASE ("GAPW_1C")
127 1360466 : basis_type_nr = gapw_1c_basis
128 : CASE ("TDA_HFX")
129 20542 : basis_type_nr = tda_k_basis
130 : CASE ("MAO")
131 149726 : basis_type_nr = mao_basis
132 : CASE ("HARRIS")
133 171500 : basis_type_nr = harris_basis
134 : CASE ("HARRIS_SOFT")
135 656 : basis_type_nr = harris_soft_basis
136 : CASE ("AUX_GW")
137 28218 : basis_type_nr = aux_gw_basis
138 : CASE ("RI_XAS")
139 22078 : basis_type_nr = ri_xas_basis
140 : CASE ("AUX_OPT")
141 24086 : basis_type_nr = aux_opt_basis
142 : CASE ("RHOIN")
143 85782 : basis_type_nr = rhoin_basis
144 : CASE ("NUC")
145 211367 : basis_type_nr = nuclear_basis
146 : CASE ("NUC_SOFT")
147 212 : basis_type_nr = nuclear_soft_basis
148 : CASE DEFAULT
149 20861935 : basis_type_nr = unknown_basis
150 : END SELECT
151 :
152 20861935 : END FUNCTION get_basis_type
153 :
154 : ! **************************************************************************************************
155 : !> \brief ...
156 : !> \param container ...
157 : !> \param basis_set ...
158 : !> \param basis_set_type ...
159 : ! **************************************************************************************************
160 49380 : SUBROUTINE add_basis_set_to_container(container, basis_set, basis_set_type)
161 : TYPE(basis_set_container_type), DIMENSION(:), &
162 : INTENT(inout) :: container
163 : TYPE(gto_basis_set_type), POINTER :: basis_set
164 : CHARACTER(len=*) :: basis_set_type
165 :
166 : INTEGER :: i
167 : LOGICAL :: success
168 :
169 24690 : success = .FALSE.
170 38925 : DO i = 1, SIZE(container)
171 38925 : IF (container(i)%basis_type_nr == 0) THEN
172 24690 : container(i)%basis_type = basis_set_type
173 24690 : container(i)%basis_set => basis_set
174 24690 : container(i)%basis_type_nr = get_basis_type(basis_set_type)
175 : success = .TRUE.
176 : EXIT
177 : END IF
178 : END DO
179 0 : CPASSERT(success)
180 :
181 24690 : END SUBROUTINE add_basis_set_to_container
182 :
183 : ! **************************************************************************************************
184 : !> \brief ...
185 : !> \param container ...
186 : !> \param inum ...
187 : !> \param basis_type ...
188 : ! **************************************************************************************************
189 2752 : SUBROUTINE remove_basis_from_container(container, inum, basis_type)
190 : TYPE(basis_set_container_type), DIMENSION(:), &
191 : INTENT(inout) :: container
192 : INTEGER, INTENT(IN), OPTIONAL :: inum
193 : CHARACTER(len=*), OPTIONAL :: basis_type
194 :
195 : INTEGER :: basis_nr, i, ibas
196 :
197 2752 : IF (PRESENT(inum)) THEN
198 0 : CPASSERT(inum <= SIZE(container))
199 0 : CPASSERT(inum >= 1)
200 : ibas = inum
201 2752 : ELSE IF (PRESENT(basis_type)) THEN
202 2752 : basis_nr = get_basis_type(basis_type)
203 2752 : ibas = 0
204 57640 : DO i = 1, SIZE(container)
205 57640 : IF (container(i)%basis_type_nr == basis_nr) THEN
206 : ibas = i
207 : EXIT
208 : END IF
209 : END DO
210 : ELSE
211 : CALL cp_abort(__LOCATION__, &
212 : "Neither inum nor basis_type exists "// &
213 0 : "for remove_basis_from_container")
214 : END IF
215 : !
216 2752 : IF (ibas /= 0) THEN
217 8 : container(ibas)%basis_type = ""
218 8 : container(ibas)%basis_type_nr = 0
219 8 : IF (ASSOCIATED(container(ibas)%basis_set)) THEN
220 8 : CALL deallocate_gto_basis_set(container(ibas)%basis_set)
221 : END IF
222 : ! shift other basis sets
223 152 : DO i = ibas + 1, SIZE(container)
224 144 : IF (container(i)%basis_type_nr == 0) CYCLE
225 0 : container(i - 1)%basis_type = container(i)%basis_type
226 0 : container(i - 1)%basis_set => container(i)%basis_set
227 0 : container(i - 1)%basis_type_nr = container(i)%basis_type_nr
228 0 : container(i)%basis_type = ""
229 0 : container(i)%basis_type_nr = 0
230 152 : NULLIFY (container(i)%basis_set)
231 : END DO
232 : END IF
233 :
234 2752 : END SUBROUTINE remove_basis_from_container
235 :
236 : ! **************************************************************************************************
237 : !> \brief Retrieve a basis set from the container
238 : !> \param container ...
239 : !> \param basis_set ...
240 : !> \param inumbas ...
241 : !> \param basis_type ...
242 : ! **************************************************************************************************
243 44288008 : SUBROUTINE get_basis_from_container(container, basis_set, inumbas, basis_type)
244 : TYPE(basis_set_container_type), DIMENSION(:), &
245 : INTENT(inout) :: container
246 : TYPE(gto_basis_set_type), POINTER :: basis_set
247 : INTEGER, OPTIONAL :: inumbas
248 : CHARACTER(len=*), OPTIONAL :: basis_type
249 :
250 : INTEGER :: basis_nr, i
251 :
252 22144004 : IF (PRESENT(inumbas)) THEN
253 1309511 : CPASSERT(inumbas <= SIZE(container))
254 1309511 : CPASSERT(inumbas >= 1)
255 1309511 : basis_set => container(inumbas)%basis_set
256 1309511 : IF (PRESENT(basis_type)) THEN
257 1309511 : basis_type = container(inumbas)%basis_type
258 : END IF
259 20834493 : ELSE IF (PRESENT(basis_type)) THEN
260 20834493 : NULLIFY (basis_set)
261 20834493 : basis_nr = get_basis_type(basis_type)
262 62507154 : DO i = 1, SIZE(container)
263 62507154 : IF (container(i)%basis_type_nr == basis_nr) THEN
264 19287178 : basis_set => container(i)%basis_set
265 19287178 : EXIT
266 : END IF
267 : END DO
268 : ELSE
269 : CALL cp_abort(__LOCATION__, &
270 : "Neither inumbas nor basis_type exists "// &
271 0 : "for get_basis_from_container")
272 : END IF
273 :
274 22144004 : END SUBROUTINE get_basis_from_container
275 : ! **************************************************************************************************
276 :
277 0 : END MODULE basis_set_container_types
|
