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