Line data Source code
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 : !> \brief generate or use from input minimal basis set
10 : !> \par History
11 : !> 03.2023 created [JGH]
12 : !> \author JGH
13 : ! **************************************************************************************************
14 : MODULE min_basis_set
15 : USE basis_set_container_types, ONLY: add_basis_set_to_container
16 : USE basis_set_types, ONLY: &
17 : allocate_sto_basis_set, create_gto_from_sto_basis, create_primitive_basis_set, &
18 : deallocate_gto_basis_set, deallocate_sto_basis_set, get_gto_basis_set, gto_basis_set_type, &
19 : init_orb_basis_set, set_sto_basis_set, srules, sto_basis_set_type
20 : USE cp_control_types, ONLY: dft_control_type
21 : USE kinds, ONLY: default_string_length,&
22 : dp
23 : USE periodic_table, ONLY: get_ptable_info,&
24 : ptable
25 : USE qs_environment_types, ONLY: get_qs_env,&
26 : qs_environment_type
27 : USE qs_interactions, ONLY: init_interaction_radii_orb_basis
28 : USE qs_kind_types, ONLY: get_qs_kind,&
29 : qs_kind_type
30 : #include "./base/base_uses.f90"
31 :
32 : IMPLICIT NONE
33 : PRIVATE
34 :
35 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'min_basis_set'
36 :
37 : PUBLIC :: create_minbas_set
38 :
39 : ! **************************************************************************************************
40 :
41 : CONTAINS
42 :
43 : ! **************************************************************************************************
44 : !> \brief ...
45 : !> \param qs_env ...
46 : !> \param unit_nr ...
47 : !> \param basis_type ...
48 : !> \param primitive ...
49 : ! **************************************************************************************************
50 38 : SUBROUTINE create_minbas_set(qs_env, unit_nr, basis_type, primitive)
51 : TYPE(qs_environment_type), POINTER :: qs_env
52 : INTEGER, INTENT(IN) :: unit_nr
53 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: basis_type
54 : INTEGER, INTENT(IN), OPTIONAL :: primitive
55 :
56 : CHARACTER(LEN=2) :: element_symbol
57 : CHARACTER(LEN=default_string_length) :: bname, btype
58 : INTEGER :: ikind, lb, mao, ne, ngau, nkind, nprim, &
59 : nsgf, ub, z
60 : INTEGER, DIMENSION(0:3) :: elcon
61 38 : INTEGER, DIMENSION(:), POINTER :: econf
62 : REAL(KIND=dp) :: zval
63 : TYPE(dft_control_type), POINTER :: dft_control
64 : TYPE(gto_basis_set_type), POINTER :: pbasis, refbasis
65 38 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
66 : TYPE(qs_kind_type), POINTER :: qs_kind
67 :
68 38 : IF (PRESENT(basis_type)) THEN
69 4 : btype = TRIM(basis_type)
70 : ELSE
71 34 : btype = "MIN"
72 : END IF
73 38 : IF (PRESENT(primitive)) THEN
74 4 : nprim = primitive
75 : ELSE
76 : nprim = -1
77 : END IF
78 :
79 : ! check for or generate reference basis
80 38 : CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
81 38 : CALL get_qs_env(qs_env, dft_control=dft_control)
82 38 : nkind = SIZE(qs_kind_set)
83 116 : DO ikind = 1, nkind
84 78 : qs_kind => qs_kind_set(ikind)
85 78 : CALL get_qs_kind(qs_kind, zeff=zval, elec_conf=econf, element_symbol=element_symbol)
86 78 : CALL get_ptable_info(element_symbol, ielement=z)
87 78 : NULLIFY (refbasis, pbasis)
88 78 : CALL get_qs_kind(qs_kind=qs_kind, basis_set=refbasis, basis_type=btype)
89 78 : IF (.NOT. ASSOCIATED(refbasis)) THEN
90 74 : CALL get_qs_kind(qs_kind=qs_kind, mao=mao)
91 : ! generate a minimal basis set
92 74 : elcon = 0
93 74 : lb = LBOUND(econf, 1)
94 74 : ub = UBOUND(econf, 1)
95 74 : ne = ub - lb
96 202 : elcon(0:ne) = econf(lb:ub)
97 74 : IF (nprim > 0) THEN
98 4 : ngau = nprim
99 4 : CALL create_min_basis(refbasis, z, elcon, mao, ngau)
100 4 : CALL create_primitive_basis_set(refbasis, pbasis)
101 4 : CALL init_interaction_radii_orb_basis(pbasis, dft_control%qs_control%eps_pgf_orb)
102 4 : CALL add_basis_set_to_container(qs_kind%basis_sets, pbasis, btype)
103 4 : CALL deallocate_gto_basis_set(refbasis)
104 : ELSE
105 : ! STO-3G
106 70 : ngau = 3
107 70 : CALL create_min_basis(refbasis, z, elcon, mao, ngau)
108 70 : CALL init_interaction_radii_orb_basis(refbasis, dft_control%qs_control%eps_pgf_orb)
109 70 : CALL add_basis_set_to_container(qs_kind%basis_sets, refbasis, btype)
110 : END IF
111 74 : CALL get_qs_kind(qs_kind=qs_kind, basis_set=refbasis, basis_type=btype)
112 : END IF
113 194 : IF (unit_nr > 0) THEN
114 39 : CALL get_gto_basis_set(refbasis, name=bname, nsgf=nsgf)
115 39 : WRITE (unit_nr, '(T2,A,A,T14,A,I4,T40,A,A24)') "Kind: ", element_symbol, "NBasFun: ", nsgf, &
116 78 : "Reference Basis: ", ADJUSTL(TRIM(bname))
117 : END IF
118 : END DO
119 :
120 38 : END SUBROUTINE create_minbas_set
121 :
122 : ! **************************************************************************************************
123 : !> \brief Creates a minimal basis set based on Slater rules
124 : !> \param min_basis_set ...
125 : !> \param zval ...
126 : !> \param econf ...
127 : !> \param mao ...
128 : !> \param ngau ...
129 : !> \par History
130 : !> 03.2023 created [JGH]
131 : ! **************************************************************************************************
132 74 : SUBROUTINE create_min_basis(min_basis_set, zval, econf, mao, ngau)
133 : TYPE(gto_basis_set_type), POINTER :: min_basis_set
134 : INTEGER, INTENT(IN) :: zval
135 : INTEGER, DIMENSION(0:3) :: econf
136 : INTEGER, INTENT(IN) :: mao, ngau
137 :
138 : CHARACTER(len=1), DIMENSION(0:3), PARAMETER :: lnam = (/"S", "P", "D", "F"/)
139 :
140 : CHARACTER(len=6) :: str
141 74 : CHARACTER(len=6), DIMENSION(:), POINTER :: sym
142 : CHARACTER(LEN=default_string_length) :: bname
143 : INTEGER :: i, iss, l, lm, n, nmao, nn, nss
144 : INTEGER, DIMENSION(0:3) :: nae, nco, npe
145 : INTEGER, DIMENSION(4, 7) :: ne
146 74 : INTEGER, DIMENSION(:), POINTER :: lq, nq
147 74 : REAL(KIND=dp), DIMENSION(:), POINTER :: zet
148 : TYPE(sto_basis_set_type), POINTER :: sto_basis_set
149 :
150 0 : CPASSERT(.NOT. ASSOCIATED(min_basis_set))
151 74 : NULLIFY (sto_basis_set)
152 :
153 : ! electronic configuration
154 74 : ne = 0
155 370 : DO l = 1, 4
156 296 : nn = 2*(l - 1) + 1
157 1998 : DO i = l, 7
158 1628 : ne(l, i) = ptable(zval)%e_conv(l - 1) - 2*nn*(i - l)
159 1628 : ne(l, i) = MAX(ne(l, i), 0)
160 1924 : ne(l, i) = MIN(ne(l, i), 2*nn)
161 : END DO
162 : END DO
163 : ! STO definition
164 74 : nae = 0
165 74 : npe = 0
166 370 : DO l = 0, 3
167 296 : nn = 2*(2*l + 1)
168 296 : nae(l) = ptable(zval)%e_conv(l)/nn
169 296 : IF (MOD(ptable(zval)%e_conv(l), nn) /= 0) nae(l) = nae(l) + 1
170 296 : npe(l) = econf(l)/nn
171 370 : IF (MOD(econf(l), nn) /= 0) npe(l) = npe(l) + 1
172 : END DO
173 370 : CPASSERT(ALL(nae - npe >= 0))
174 370 : nco = nae - npe
175 : ! MAO count
176 : nmao = 0
177 370 : DO l = 0, 3
178 370 : nmao = nmao + npe(l)*(2*l + 1)
179 : END DO
180 :
181 74 : IF (mao > nmao) THEN
182 2 : nmao = mao - nmao
183 2 : SELECT CASE (nmao)
184 : CASE (1)
185 2 : npe(0) = npe(0) + 1
186 : CASE (2)
187 0 : npe(0) = npe(0) + 2
188 : CASE (3)
189 0 : npe(1) = npe(1) + 1
190 : CASE (4)
191 0 : npe(0) = npe(0) + 1
192 0 : npe(1) = npe(1) + 1
193 : CASE (5)
194 0 : IF (npe(2) == 0) THEN
195 0 : npe(2) = npe(2) + 1
196 : ELSE
197 0 : npe(0) = npe(0) + 2
198 0 : npe(1) = npe(1) + 1
199 : END IF
200 : CASE (6)
201 0 : npe(0) = npe(0) + 1
202 0 : npe(2) = npe(2) + 1
203 : CASE (7)
204 0 : npe(0) = npe(0) + 2
205 0 : npe(2) = npe(2) + 1
206 : CASE (8)
207 0 : npe(0) = npe(0) + 3
208 0 : npe(2) = npe(2) + 1
209 : CASE (9)
210 0 : npe(0) = npe(0) + 1
211 0 : npe(1) = npe(1) + 1
212 0 : npe(2) = npe(2) + 1
213 : CASE DEFAULT
214 2 : CPABORT("Default setting of minimal basis failed")
215 : END SELECT
216 2 : CALL cp_warn(__LOCATION__, "Reference basis has been adjusted according to MAO value.")
217 : END IF
218 :
219 : ! All shells should have at least 1 function
220 74 : lm = 0
221 370 : DO l = 0, 3
222 370 : IF (npe(l) > 0) lm = l
223 : END DO
224 188 : DO l = 0, lm
225 188 : IF (npe(l) == 0) npe(l) = 1
226 : END DO
227 :
228 370 : nss = SUM(npe)
229 592 : ALLOCATE (sym(nss), lq(nss), nq(nss), zet(nss))
230 74 : iss = 0
231 370 : DO l = 0, 3
232 492 : DO i = 1, npe(l)
233 122 : iss = iss + 1
234 122 : lq(iss) = l
235 122 : n = nco(l) + l
236 122 : nq(iss) = n + i
237 122 : str = " "
238 122 : WRITE (str(5:5), FMT='(I1)') nq(iss)
239 122 : str(6:6) = lnam(l)
240 122 : sym(iss) = str
241 418 : zet(iss) = srules(zval, ne, nq(iss), lq(iss))
242 : END DO
243 : END DO
244 :
245 74 : bname = ADJUSTR(ptable(zval)%symbol)//"_MBas"
246 74 : CALL allocate_sto_basis_set(sto_basis_set)
247 : CALL set_sto_basis_set(sto_basis_set, name=bname, nshell=nss, nq=nq, &
248 74 : lq=lq, zet=zet, symbol=sym)
249 74 : CALL create_gto_from_sto_basis(sto_basis_set, min_basis_set, ngau)
250 74 : min_basis_set%norm_type = 2
251 74 : CALL init_orb_basis_set(min_basis_set)
252 74 : CALL deallocate_sto_basis_set(sto_basis_set)
253 :
254 74 : DEALLOCATE (sym, lq, nq, zet)
255 :
256 74 : END SUBROUTINE create_min_basis
257 :
258 : ! **************************************************************************************************
259 :
260 : END MODULE min_basis_set
|
