(git:d18deda)
Loading...
Searching...
No Matches
basis_set_container_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 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! **************************************************************************************************
13MODULE 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! **************************************************************************************************
51 TYPE basis_set_container_type
52 PRIVATE
53 CHARACTER(LEN=default_string_length) :: basis_type = ""
54 INTEGER :: basis_type_nr = 0
55 TYPE(gto_basis_set_type), POINTER :: basis_set => null()
56 END TYPE basis_set_container_type
57! **************************************************************************************************
58
59 PUBLIC :: basis_set_container_type
60
61 PUBLIC :: remove_basis_set_container, &
62 add_basis_set_to_container, get_basis_from_container, &
63 remove_basis_from_container
64
65! **************************************************************************************************
66
67CONTAINS
68
69! **************************************************************************************************
70!> \brief ...
71!> \param basis ...
72! **************************************************************************************************
73 SUBROUTINE remove_basis_set_container(basis)
74 TYPE(basis_set_container_type), DIMENSION(:), &
75 INTENT(inout) :: basis
76
77 INTEGER :: i
78
79 DO i = 1, SIZE(basis)
80 basis(i)%basis_type = ""
81 basis(i)%basis_type_nr = 0
82 IF (ASSOCIATED(basis(i)%basis_set)) THEN
83 CALL deallocate_gto_basis_set(basis(i)%basis_set)
84 END IF
85 END DO
86
87 END SUBROUTINE remove_basis_set_container
88
89! **************************************************************************************************
90!> \brief ...
91!> \param basis_set_type ...
92!> \return ...
93! **************************************************************************************************
94 FUNCTION get_basis_type(basis_set_type) RESULT(basis_type_nr)
95 CHARACTER(len=*) :: basis_set_type
96 INTEGER :: basis_type_nr
97
98 SELECT CASE (basis_set_type)
99 CASE ("ORB")
100 basis_type_nr = orbital_basis
101 CASE ("AUX")
102 basis_type_nr = auxiliary_basis
103 CASE ("MIN")
104 basis_type_nr = min_basis
105 CASE ("RI_AUX")
106 basis_type_nr = ri_aux_basis
107 CASE ("RI_HXC")
108 basis_type_nr = ri_hxc_basis
109 CASE ("RI_HFX")
110 basis_type_nr = ri_hfx_basis
111 CASE ("RI_K")
112 basis_type_nr = ri_k_basis
113 CASE ("LRI_AUX")
114 basis_type_nr = lri_aux_basis
115 CASE ("P_LRI_AUX")
116 basis_type_nr = p_lri_aux_basis
117 CASE ("AUX_FIT")
118 basis_type_nr = aux_fit_basis
119 CASE ("AUX_FIT_SOFT")
120 basis_type_nr = aux_fit_soft_basis
121 CASE ("ORB_SOFT")
122 basis_type_nr = soft_basis
123 CASE ("GAPW_1C")
124 basis_type_nr = gapw_1c_basis
125 CASE ("TDA_HFX")
126 basis_type_nr = tda_k_basis
127 CASE ("MAO")
128 basis_type_nr = mao_basis
129 CASE ("HARRIS")
130 basis_type_nr = harris_basis
131 CASE ("AUX_GW")
132 basis_type_nr = aux_gw_basis
133 CASE ("RI_XAS")
134 basis_type_nr = ri_xas_basis
135 CASE ("AUX_OPT")
136 basis_type_nr = aux_opt_basis
137 CASE ("RHOIN")
138 basis_type_nr = rhoin_basis
139 CASE DEFAULT
140 basis_type_nr = unknown_basis
141 END SELECT
142
143 END FUNCTION get_basis_type
144
145! **************************************************************************************************
146!> \brief ...
147!> \param container ...
148!> \param basis_set ...
149!> \param basis_set_type ...
150! **************************************************************************************************
151 SUBROUTINE add_basis_set_to_container(container, basis_set, basis_set_type)
152 TYPE(basis_set_container_type), DIMENSION(:), &
153 INTENT(inout) :: container
154 TYPE(gto_basis_set_type), POINTER :: basis_set
155 CHARACTER(len=*) :: basis_set_type
156
157 INTEGER :: i
158 LOGICAL :: success
159
160 success = .false.
161 DO i = 1, SIZE(container)
162 IF (container(i)%basis_type_nr == 0) THEN
163 container(i)%basis_type = basis_set_type
164 container(i)%basis_set => basis_set
165 container(i)%basis_type_nr = get_basis_type(basis_set_type)
166 success = .true.
167 EXIT
168 END IF
169 END DO
170 cpassert(success)
171
172 END SUBROUTINE add_basis_set_to_container
173
174! **************************************************************************************************
175!> \brief ...
176!> \param container ...
177!> \param inum ...
178!> \param basis_type ...
179! **************************************************************************************************
180 SUBROUTINE remove_basis_from_container(container, inum, basis_type)
181 TYPE(basis_set_container_type), DIMENSION(:), &
182 INTENT(inout) :: container
183 INTEGER, INTENT(IN), OPTIONAL :: inum
184 CHARACTER(len=*), OPTIONAL :: basis_type
185
186 INTEGER :: basis_nr, i, ibas
187
188 IF (PRESENT(inum)) THEN
189 cpassert(inum <= SIZE(container))
190 cpassert(inum >= 1)
191 ibas = inum
192 ELSE IF (PRESENT(basis_type)) THEN
193 basis_nr = get_basis_type(basis_type)
194 ibas = 0
195 DO i = 1, SIZE(container)
196 IF (container(i)%basis_type_nr == basis_nr) THEN
197 ibas = i
198 EXIT
199 END IF
200 END DO
201 ELSE
202 cpabort("")
203 END IF
204 !
205 IF (ibas /= 0) THEN
206 container(ibas)%basis_type = ""
207 container(ibas)%basis_type_nr = 0
208 IF (ASSOCIATED(container(ibas)%basis_set)) THEN
209 CALL deallocate_gto_basis_set(container(ibas)%basis_set)
210 END IF
211 ! shift other basis sets
212 DO i = ibas + 1, SIZE(container)
213 IF (container(i)%basis_type_nr == 0) cycle
214 container(i - 1)%basis_type = container(i)%basis_type
215 container(i - 1)%basis_set => container(i)%basis_set
216 container(i - 1)%basis_type_nr = container(i)%basis_type_nr
217 container(i)%basis_type = ""
218 container(i)%basis_type_nr = 0
219 NULLIFY (container(i)%basis_set)
220 END DO
221 END IF
222
223 END SUBROUTINE remove_basis_from_container
224
225! **************************************************************************************************
226!> \brief Retrieve a basis set from the container
227!> \param container ...
228!> \param basis_set ...
229!> \param inumbas ...
230!> \param basis_type ...
231! **************************************************************************************************
232 SUBROUTINE get_basis_from_container(container, basis_set, inumbas, basis_type)
233 TYPE(basis_set_container_type), DIMENSION(:), &
234 INTENT(inout) :: container
235 TYPE(gto_basis_set_type), POINTER :: basis_set
236 INTEGER, OPTIONAL :: inumbas
237 CHARACTER(len=*), OPTIONAL :: basis_type
238
239 INTEGER :: basis_nr, i
240
241 IF (PRESENT(inumbas)) THEN
242 cpassert(inumbas <= SIZE(container))
243 cpassert(inumbas >= 1)
244 basis_set => container(inumbas)%basis_set
245 IF (PRESENT(basis_type)) THEN
246 basis_type = container(inumbas)%basis_type
247 END IF
248 ELSE IF (PRESENT(basis_type)) THEN
249 NULLIFY (basis_set)
250 basis_nr = get_basis_type(basis_type)
251 DO i = 1, SIZE(container)
252 IF (container(i)%basis_type_nr == basis_nr) THEN
253 basis_set => container(i)%basis_set
254 EXIT
255 END IF
256 END DO
257 ELSE
258 cpabort("")
259 END IF
260
261 END SUBROUTINE get_basis_from_container
262! **************************************************************************************************
263
264END MODULE basis_set_container_types
basis_set_container_types
Definition basis_set_container_types.F:13
basis_set_container_types::remove_basis_set_container
subroutine, public remove_basis_set_container(basis)
...
Definition basis_set_container_types.F:74
basis_set_container_types::remove_basis_from_container
subroutine, public remove_basis_from_container(container, inum, basis_type)
...
Definition basis_set_container_types.F:181
basis_set_container_types::get_basis_from_container
subroutine, public get_basis_from_container(container, basis_set, inumbas, basis_type)
Retrieve a basis set from the container.
Definition basis_set_container_types.F:233
basis_set_container_types::add_basis_set_to_container
subroutine, public add_basis_set_to_container(container, basis_set, basis_set_type)
...
Definition basis_set_container_types.F:152
basis_set_types
Definition basis_set_types.F:15
basis_set_types::deallocate_gto_basis_set
subroutine, public deallocate_gto_basis_set(gto_basis_set)
...
Definition basis_set_types.F:169
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
mao_basis
Calculate MAO's and analyze wavefunctions.
Definition mao_basis.F:15
basis_set_container_types::basis_set_container_type
Definition basis_set_container_types.F:51
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72