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 38 : IF (unit_nr > 0) THEN
80 19 : WRITE (unit_nr, '(T2,A,T60,A21)') "Generate MINBAS set", ADJUSTR(TRIM(btype))
81 : END IF
82 : ! check for or generate reference basis
83 38 : CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
84 38 : CALL get_qs_env(qs_env, dft_control=dft_control)
85 38 : nkind = SIZE(qs_kind_set)
86 116 : DO ikind = 1, nkind
87 78 : qs_kind => qs_kind_set(ikind)
88 78 : CALL get_qs_kind(qs_kind, zeff=zval, elec_conf=econf, element_symbol=element_symbol)
89 78 : CALL get_ptable_info(element_symbol, ielement=z)
90 78 : NULLIFY (refbasis, pbasis)
91 78 : CALL get_qs_kind(qs_kind=qs_kind, basis_set=refbasis, basis_type=btype)
92 78 : IF (.NOT. ASSOCIATED(refbasis)) THEN
93 74 : CALL get_qs_kind(qs_kind=qs_kind, mao=mao)
94 : ! generate a minimal basis set
95 74 : elcon = 0
96 74 : lb = LBOUND(econf, 1)
97 74 : ub = UBOUND(econf, 1)
98 74 : ne = ub - lb
99 202 : elcon(0:ne) = econf(lb:ub)
100 74 : IF (nprim > 0) THEN
101 4 : ngau = nprim
102 4 : CALL create_min_basis(refbasis, z, elcon, mao, ngau)
103 4 : CALL create_primitive_basis_set(refbasis, pbasis)
104 4 : CALL init_interaction_radii_orb_basis(pbasis, dft_control%qs_control%eps_pgf_orb)
105 4 : CALL add_basis_set_to_container(qs_kind%basis_sets, pbasis, btype)
106 4 : CALL deallocate_gto_basis_set(refbasis)
107 : ELSE
108 : ! STO-3G
109 70 : ngau = 3
110 70 : CALL create_min_basis(refbasis, z, elcon, mao, ngau)
111 70 : CALL init_interaction_radii_orb_basis(refbasis, dft_control%qs_control%eps_pgf_orb)
112 70 : CALL add_basis_set_to_container(qs_kind%basis_sets, refbasis, btype)
113 : END IF
114 74 : CALL get_qs_kind(qs_kind=qs_kind, basis_set=refbasis, basis_type=btype)
115 : END IF
116 194 : IF (unit_nr > 0) THEN
117 39 : CALL get_gto_basis_set(refbasis, name=bname, nsgf=nsgf)
118 39 : WRITE (unit_nr, '(T2,A,A,T14,A,I4,T40,A,A24)') "Kind: ", element_symbol, "NBasFun: ", nsgf, &
119 78 : "Reference Basis: ", ADJUSTL(TRIM(bname))
120 : END IF
121 : END DO
122 :
123 38 : END SUBROUTINE create_minbas_set
124 :
125 : ! **************************************************************************************************
126 : !> \brief Creates a minimal basis set based on Slater rules
127 : !> \param min_basis_set ...
128 : !> \param zval ...
129 : !> \param econf ...
130 : !> \param mao ...
131 : !> \param ngau ...
132 : !> \par History
133 : !> 03.2023 created [JGH]
134 : ! **************************************************************************************************
135 74 : SUBROUTINE create_min_basis(min_basis_set, zval, econf, mao, ngau)
136 : TYPE(gto_basis_set_type), POINTER :: min_basis_set
137 : INTEGER, INTENT(IN) :: zval
138 : INTEGER, DIMENSION(0:3) :: econf
139 : INTEGER, INTENT(IN) :: mao, ngau
140 :
141 : CHARACTER(len=1), DIMENSION(0:3), PARAMETER :: lnam = (/"S", "P", "D", "F"/)
142 :
143 : CHARACTER(len=6) :: str
144 74 : CHARACTER(len=6), DIMENSION(:), POINTER :: sym
145 : CHARACTER(LEN=default_string_length) :: bname
146 : INTEGER :: i, iss, l, lm, n, nmao, nn, nss
147 : INTEGER, DIMENSION(0:3) :: nae, nco, npe
148 : INTEGER, DIMENSION(4, 7) :: ne
149 74 : INTEGER, DIMENSION(:), POINTER :: lq, nq
150 74 : REAL(KIND=dp), DIMENSION(:), POINTER :: zet
151 : TYPE(sto_basis_set_type), POINTER :: sto_basis_set
152 :
153 0 : CPASSERT(.NOT. ASSOCIATED(min_basis_set))
154 74 : NULLIFY (sto_basis_set)
155 :
156 : ! electronic configuration
157 74 : ne = 0
158 370 : DO l = 1, 4
159 296 : nn = 2*(l - 1) + 1
160 1998 : DO i = l, 7
161 1628 : ne(l, i) = ptable(zval)%e_conv(l - 1) - 2*nn*(i - l)
162 1628 : ne(l, i) = MAX(ne(l, i), 0)
163 1924 : ne(l, i) = MIN(ne(l, i), 2*nn)
164 : END DO
165 : END DO
166 : ! STO definition
167 74 : nae = 0
168 74 : npe = 0
169 370 : DO l = 0, 3
170 296 : nn = 2*(2*l + 1)
171 296 : nae(l) = ptable(zval)%e_conv(l)/nn
172 296 : IF (MOD(ptable(zval)%e_conv(l), nn) /= 0) nae(l) = nae(l) + 1
173 296 : npe(l) = econf(l)/nn
174 370 : IF (MOD(econf(l), nn) /= 0) npe(l) = npe(l) + 1
175 : END DO
176 370 : CPASSERT(ALL(nae - npe >= 0))
177 370 : nco = nae - npe
178 : ! MAO count
179 : nmao = 0
180 370 : DO l = 0, 3
181 370 : nmao = nmao + npe(l)*(2*l + 1)
182 : END DO
183 :
184 74 : IF (mao > nmao) THEN
185 2 : nmao = mao - nmao
186 2 : SELECT CASE (nmao)
187 : CASE (1)
188 2 : npe(0) = npe(0) + 1
189 : CASE (2)
190 0 : npe(0) = npe(0) + 2
191 : CASE (3)
192 0 : npe(1) = npe(1) + 1
193 : CASE (4)
194 0 : npe(0) = npe(0) + 1
195 0 : npe(1) = npe(1) + 1
196 : CASE (5)
197 0 : IF (npe(2) == 0) THEN
198 0 : npe(2) = npe(2) + 1
199 : ELSE
200 0 : npe(0) = npe(0) + 2
201 0 : npe(1) = npe(1) + 1
202 : END IF
203 : CASE (6)
204 0 : npe(0) = npe(0) + 1
205 0 : npe(2) = npe(2) + 1
206 : CASE (7)
207 0 : npe(0) = npe(0) + 2
208 0 : npe(2) = npe(2) + 1
209 : CASE (8)
210 0 : npe(0) = npe(0) + 3
211 0 : npe(2) = npe(2) + 1
212 : CASE (9)
213 0 : npe(0) = npe(0) + 1
214 0 : npe(1) = npe(1) + 1
215 0 : npe(2) = npe(2) + 1
216 : CASE DEFAULT
217 2 : CPABORT("Default setting of minimal basis failed")
218 : END SELECT
219 2 : CALL cp_warn(__LOCATION__, "Reference basis has been adjusted according to MAO value.")
220 : END IF
221 :
222 : ! All shells should have at least 1 function
223 74 : lm = 0
224 370 : DO l = 0, 3
225 370 : IF (npe(l) > 0) lm = l
226 : END DO
227 188 : DO l = 0, lm
228 188 : IF (npe(l) == 0) npe(l) = 1
229 : END DO
230 :
231 370 : nss = SUM(npe)
232 592 : ALLOCATE (sym(nss), lq(nss), nq(nss), zet(nss))
233 74 : iss = 0
234 370 : DO l = 0, 3
235 492 : DO i = 1, npe(l)
236 122 : iss = iss + 1
237 122 : lq(iss) = l
238 122 : n = nco(l) + l
239 122 : nq(iss) = n + i
240 122 : str = " "
241 122 : WRITE (str(5:5), FMT='(I1)') nq(iss)
242 122 : str(6:6) = lnam(l)
243 122 : sym(iss) = str
244 418 : zet(iss) = srules(zval, ne, nq(iss), lq(iss))
245 : END DO
246 : END DO
247 :
248 74 : bname = ADJUSTR(ptable(zval)%symbol)//"_MBas"
249 74 : CALL allocate_sto_basis_set(sto_basis_set)
250 : CALL set_sto_basis_set(sto_basis_set, name=bname, nshell=nss, nq=nq, &
251 74 : lq=lq, zet=zet, symbol=sym)
252 74 : CALL create_gto_from_sto_basis(sto_basis_set, min_basis_set, ngau)
253 74 : min_basis_set%norm_type = 2
254 74 : CALL init_orb_basis_set(min_basis_set)
255 74 : CALL deallocate_sto_basis_set(sto_basis_set)
256 :
257 74 : DEALLOCATE (sym, lq, nq, zet)
258 :
259 74 : END SUBROUTINE create_min_basis
260 :
261 : ! **************************************************************************************************
262 :
263 : END MODULE min_basis_set
|
