(git:b31c023)
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 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
70CONTAINS
71
72! **************************************************************************************************
73!> \brief ...
74!> \param basis ...
75! **************************************************************************************************
76 SUBROUTINE remove_basis_set_container(basis)
77 TYPE(basis_set_container_type), DIMENSION(:), &
78 INTENT(inout) :: basis
79
80 INTEGER :: i
81
82 DO i = 1, SIZE(basis)
83 basis(i)%basis_type = ""
84 basis(i)%basis_type_nr = 0
85 IF (ASSOCIATED(basis(i)%basis_set)) THEN
86 CALL deallocate_gto_basis_set(basis(i)%basis_set)
87 END IF
88 END DO
89
90 END SUBROUTINE remove_basis_set_container
91
92! **************************************************************************************************
93!> \brief ...
94!> \param basis_set_type ...
95!> \return ...
96! **************************************************************************************************
97 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 basis_type_nr = orbital_basis
104 CASE ("AUX")
105 basis_type_nr = auxiliary_basis
106 CASE ("MIN")
107 basis_type_nr = min_basis
108 CASE ("RI_AUX")
109 basis_type_nr = ri_aux_basis
110 CASE ("RI_HXC")
111 basis_type_nr = ri_hxc_basis
112 CASE ("RI_HFX")
113 basis_type_nr = ri_hfx_basis
114 CASE ("RI_K")
115 basis_type_nr = ri_k_basis
116 CASE ("LRI_AUX")
117 basis_type_nr = lri_aux_basis
118 CASE ("P_LRI_AUX")
119 basis_type_nr = p_lri_aux_basis
120 CASE ("AUX_FIT")
121 basis_type_nr = aux_fit_basis
122 CASE ("AUX_FIT_SOFT")
123 basis_type_nr = aux_fit_soft_basis
124 CASE ("ORB_SOFT")
125 basis_type_nr = soft_basis
126 CASE ("GAPW_1C")
127 basis_type_nr = gapw_1c_basis
128 CASE ("TDA_HFX")
129 basis_type_nr = tda_k_basis
130 CASE ("MAO")
131 basis_type_nr = mao_basis
132 CASE ("HARRIS")
133 basis_type_nr = harris_basis
134 CASE ("HARRIS_SOFT")
135 basis_type_nr = harris_soft_basis
136 CASE ("AUX_GW")
137 basis_type_nr = aux_gw_basis
138 CASE ("RI_XAS")
139 basis_type_nr = ri_xas_basis
140 CASE ("AUX_OPT")
141 basis_type_nr = aux_opt_basis
142 CASE ("RHOIN")
143 basis_type_nr = rhoin_basis
144 CASE ("NUC")
145 basis_type_nr = nuclear_basis
146 CASE ("NUC_SOFT")
147 basis_type_nr = nuclear_soft_basis
148 CASE DEFAULT
149 basis_type_nr = unknown_basis
150 END SELECT
151
152 END FUNCTION get_basis_type
153
154! **************************************************************************************************
155!> \brief ...
156!> \param container ...
157!> \param basis_set ...
158!> \param basis_set_type ...
159! **************************************************************************************************
160 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 success = .false.
170 DO i = 1, SIZE(container)
171 IF (container(i)%basis_type_nr == 0) THEN
172 container(i)%basis_type = basis_set_type
173 container(i)%basis_set => basis_set
174 container(i)%basis_type_nr = get_basis_type(basis_set_type)
175 success = .true.
176 EXIT
177 END IF
178 END DO
179 cpassert(success)
180
181 END SUBROUTINE add_basis_set_to_container
182
183! **************************************************************************************************
184!> \brief ...
185!> \param container ...
186!> \param inum ...
187!> \param basis_type ...
188! **************************************************************************************************
189 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 IF (PRESENT(inum)) THEN
198 cpassert(inum <= SIZE(container))
199 cpassert(inum >= 1)
200 ibas = inum
201 ELSE IF (PRESENT(basis_type)) THEN
202 basis_nr = get_basis_type(basis_type)
203 ibas = 0
204 DO i = 1, SIZE(container)
205 IF (container(i)%basis_type_nr == basis_nr) THEN
206 ibas = i
207 EXIT
208 END IF
209 END DO
210 ELSE
211 cpabort("")
212 END IF
213 !
214 IF (ibas /= 0) THEN
215 container(ibas)%basis_type = ""
216 container(ibas)%basis_type_nr = 0
217 IF (ASSOCIATED(container(ibas)%basis_set)) THEN
218 CALL deallocate_gto_basis_set(container(ibas)%basis_set)
219 END IF
220 ! shift other basis sets
221 DO i = ibas + 1, SIZE(container)
222 IF (container(i)%basis_type_nr == 0) cycle
223 container(i - 1)%basis_type = container(i)%basis_type
224 container(i - 1)%basis_set => container(i)%basis_set
225 container(i - 1)%basis_type_nr = container(i)%basis_type_nr
226 container(i)%basis_type = ""
227 container(i)%basis_type_nr = 0
228 NULLIFY (container(i)%basis_set)
229 END DO
230 END IF
231
232 END SUBROUTINE remove_basis_from_container
233
234! **************************************************************************************************
235!> \brief Retrieve a basis set from the container
236!> \param container ...
237!> \param basis_set ...
238!> \param inumbas ...
239!> \param basis_type ...
240! **************************************************************************************************
241 SUBROUTINE get_basis_from_container(container, basis_set, inumbas, basis_type)
242 TYPE(basis_set_container_type), DIMENSION(:), &
243 INTENT(inout) :: container
244 TYPE(gto_basis_set_type), POINTER :: basis_set
245 INTEGER, OPTIONAL :: inumbas
246 CHARACTER(len=*), OPTIONAL :: basis_type
247
248 INTEGER :: basis_nr, i
249
250 IF (PRESENT(inumbas)) THEN
251 cpassert(inumbas <= SIZE(container))
252 cpassert(inumbas >= 1)
253 basis_set => container(inumbas)%basis_set
254 IF (PRESENT(basis_type)) THEN
255 basis_type = container(inumbas)%basis_type
256 END IF
257 ELSE IF (PRESENT(basis_type)) THEN
258 NULLIFY (basis_set)
259 basis_nr = get_basis_type(basis_type)
260 DO i = 1, SIZE(container)
261 IF (container(i)%basis_type_nr == basis_nr) THEN
262 basis_set => container(i)%basis_set
263 EXIT
264 END IF
265 END DO
266 ELSE
267 cpabort("")
268 END IF
269
270 END SUBROUTINE get_basis_from_container
271! **************************************************************************************************
272
273END 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:77
basis_set_container_types::remove_basis_from_container
subroutine, public remove_basis_from_container(container, inum, basis_type)
...
Definition basis_set_container_types.F:190
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:242
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:161
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:170
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:54
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72