(git:e7e05ae)
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 ! **************************************************************************************************
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 ! **************************************************************************************************
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 
66 CONTAINS
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 
261 END 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