(git:50ddb19)
Loading...
Searching...
No Matches
basis_set_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \par History
10!> - 02.2004 flexible normalization of basis sets [jgh]
11!> - 07.2014 Add a set of contraction coefficient that only work on active
12!> functions
13!> \author Matthias Krack (04.07.2000)
14! **************************************************************************************************
15MODULE basis_set_types
16
17 USE ai_coulomb, ONLY: coulomb2
18 USE bibliography, ONLY: vandevondele2007,&
19 cite_reference
20 USE cp_linked_list_input, ONLY: cp_sll_val_next,&
21 cp_sll_val_type
22 USE cp_parser_methods, ONLY: parser_get_object,&
23 parser_search_string
24 USE cp_parser_types, ONLY: cp_parser_type,&
25 parser_create,&
26 parser_release
27 USE input_section_types, ONLY: section_vals_list_get,&
28 section_vals_type,&
29 section_vals_val_get
30 USE input_val_types, ONLY: val_get,&
31 val_type
32 USE kinds, ONLY: default_path_length,&
33 default_string_length,&
34 dp
35 USE mathconstants, ONLY: dfac,&
36 pi
37 USE memory_utilities, ONLY: reallocate
38 USE message_passing, ONLY: mp_para_env_type
39 USE orbital_pointers, ONLY: coset,&
40 indco,&
41 init_orbital_pointers,&
42 nco,&
43 ncoset,&
44 nso,&
45 nsoset
46 USE orbital_symbols, ONLY: cgf_symbol,&
47 sgf_symbol
48 USE orbital_transformation_matrices, ONLY: init_spherical_harmonics,&
49 orbtramat
50 USE sto_ng, ONLY: get_sto_ng
51 USE string_utilities, ONLY: integer_to_string,&
52 remove_word,&
53 uppercase
54 USE util, ONLY: sort
55#include "../base/base_uses.f90"
56
57 IMPLICIT NONE
58
59 PRIVATE
60
61 ! Global parameters (only in this module)
62
63 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'basis_set_types'
64
65 ! basis set sort criteria
66 INTEGER, PARAMETER, PUBLIC :: basis_sort_default = 0, &
67 basis_sort_zet = 1
68
69! **************************************************************************************************
70 ! Define the Gaussian-type orbital basis set type
71
72 TYPE gto_basis_set_type
73 !MK PRIVATE
74 CHARACTER(LEN=default_string_length) :: name = ""
75 CHARACTER(LEN=default_string_length) :: aliases = ""
76 REAL(kind=dp) :: kind_radius = 0.0_dp
77 REAL(kind=dp) :: short_kind_radius = 0.0_dp
78 INTEGER :: norm_type = -1
79 INTEGER :: ncgf = -1, nset = -1, nsgf = -1
80 CHARACTER(LEN=12), DIMENSION(:), POINTER :: cgf_symbol => null()
81 CHARACTER(LEN=6), DIMENSION(:), POINTER :: sgf_symbol => null()
82 REAL(kind=dp), DIMENSION(:), POINTER :: norm_cgf => null(), set_radius => null()
83 INTEGER, DIMENSION(:), POINTER :: lmax => null(), lmin => null(), &
84 lx => null(), ly => null(), lz => null(), &
85 m => null(), ncgf_set => null(), &
86 npgf => null(), nsgf_set => null(), nshell => null()
87 REAL(kind=dp), DIMENSION(:, :), POINTER :: cphi => null(), pgf_radius => null(), sphi => null(), &
88 scon => null(), zet => null(), ccon => null()
89 INTEGER, DIMENSION(:, :), POINTER :: first_cgf => null(), first_sgf => null(), l => null(), &
90 last_cgf => null(), last_sgf => null(), n => null()
91 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: gcc => null()
92 END TYPE gto_basis_set_type
93
94 TYPE gto_basis_set_p_type
95 TYPE(gto_basis_set_type), POINTER :: gto_basis_set => null()
96 END TYPE gto_basis_set_p_type
97
98! **************************************************************************************************
99 ! Define the Slater-type orbital basis set type
100
101 TYPE sto_basis_set_type
102 PRIVATE
103 CHARACTER(LEN=default_string_length) :: name = ""
104 INTEGER :: nshell = -1
105 CHARACTER(LEN=6), DIMENSION(:), POINTER :: symbol => null()
106 INTEGER, DIMENSION(:), POINTER :: nq => null(), lq => null()
107 REAL(kind=dp), DIMENSION(:), POINTER :: zet => null()
108 END TYPE sto_basis_set_type
109
110! **************************************************************************************************
111 INTERFACE read_gto_basis_set
112 MODULE PROCEDURE read_gto_basis_set1, read_gto_basis_set2
113 END INTERFACE
114! **************************************************************************************************
115
116 ! Public subroutines
117 PUBLIC :: allocate_gto_basis_set, &
118 deallocate_gto_basis_set, &
119 get_gto_basis_set, &
120 init_aux_basis_set, &
121 init_cphi_and_sphi, &
122 init_orb_basis_set, &
123 read_gto_basis_set, &
124 copy_gto_basis_set, &
125 create_primitive_basis_set, &
126 combine_basis_sets, &
127 set_gto_basis_set, &
128 sort_gto_basis_set, &
129 write_gto_basis_set, &
130 dump_gto_basis_set, &
131 write_orb_basis_set
132
133 PUBLIC :: allocate_sto_basis_set, &
134 read_sto_basis_set, &
135 create_gto_from_sto_basis, &
136 deallocate_sto_basis_set, &
137 set_sto_basis_set, &
138 srules, process_gto_basis
139
140 ! Public data types
141 PUBLIC :: gto_basis_set_p_type, &
142 gto_basis_set_type, &
143 sto_basis_set_type
144
145CONTAINS
146
147! **************************************************************************************************
148!> \brief ...
149!> \param gto_basis_set ...
150! **************************************************************************************************
151 SUBROUTINE allocate_gto_basis_set(gto_basis_set)
152
153 ! Allocate a Gaussian-type orbital (GTO) basis set data set.
154
155 ! - Creation (26.10.2000,MK)
156
157 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
158
159 CALL deallocate_gto_basis_set(gto_basis_set)
160
161 ALLOCATE (gto_basis_set)
162
163 END SUBROUTINE allocate_gto_basis_set
164
165! **************************************************************************************************
166!> \brief ...
167!> \param gto_basis_set ...
168! **************************************************************************************************
169 SUBROUTINE deallocate_gto_basis_set(gto_basis_set)
170
171 ! Deallocate a Gaussian-type orbital (GTO) basis set data set.
172
173 ! - Creation (03.11.2000,MK)
174
175 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
176
177 IF (ASSOCIATED(gto_basis_set)) THEN
178 IF (ASSOCIATED(gto_basis_set%cgf_symbol)) DEALLOCATE (gto_basis_set%cgf_symbol)
179 IF (ASSOCIATED(gto_basis_set%sgf_symbol)) DEALLOCATE (gto_basis_set%sgf_symbol)
180 IF (ASSOCIATED(gto_basis_set%norm_cgf)) DEALLOCATE (gto_basis_set%norm_cgf)
181 IF (ASSOCIATED(gto_basis_set%set_radius)) DEALLOCATE (gto_basis_set%set_radius)
182 IF (ASSOCIATED(gto_basis_set%lmax)) DEALLOCATE (gto_basis_set%lmax)
183 IF (ASSOCIATED(gto_basis_set%lmin)) DEALLOCATE (gto_basis_set%lmin)
184 IF (ASSOCIATED(gto_basis_set%lx)) DEALLOCATE (gto_basis_set%lx)
185 IF (ASSOCIATED(gto_basis_set%ly)) DEALLOCATE (gto_basis_set%ly)
186 IF (ASSOCIATED(gto_basis_set%lz)) DEALLOCATE (gto_basis_set%lz)
187 IF (ASSOCIATED(gto_basis_set%m)) DEALLOCATE (gto_basis_set%m)
188 IF (ASSOCIATED(gto_basis_set%ncgf_set)) DEALLOCATE (gto_basis_set%ncgf_set)
189 IF (ASSOCIATED(gto_basis_set%npgf)) DEALLOCATE (gto_basis_set%npgf)
190 IF (ASSOCIATED(gto_basis_set%nsgf_set)) DEALLOCATE (gto_basis_set%nsgf_set)
191 IF (ASSOCIATED(gto_basis_set%nshell)) DEALLOCATE (gto_basis_set%nshell)
192 IF (ASSOCIATED(gto_basis_set%cphi)) DEALLOCATE (gto_basis_set%cphi)
193 IF (ASSOCIATED(gto_basis_set%pgf_radius)) DEALLOCATE (gto_basis_set%pgf_radius)
194 IF (ASSOCIATED(gto_basis_set%sphi)) DEALLOCATE (gto_basis_set%sphi)
195 IF (ASSOCIATED(gto_basis_set%scon)) DEALLOCATE (gto_basis_set%scon)
196 IF (ASSOCIATED(gto_basis_set%ccon)) DEALLOCATE (gto_basis_set%ccon)
197 IF (ASSOCIATED(gto_basis_set%zet)) DEALLOCATE (gto_basis_set%zet)
198 IF (ASSOCIATED(gto_basis_set%first_cgf)) DEALLOCATE (gto_basis_set%first_cgf)
199 IF (ASSOCIATED(gto_basis_set%first_sgf)) DEALLOCATE (gto_basis_set%first_sgf)
200 IF (ASSOCIATED(gto_basis_set%l)) DEALLOCATE (gto_basis_set%l)
201 IF (ASSOCIATED(gto_basis_set%last_cgf)) DEALLOCATE (gto_basis_set%last_cgf)
202 IF (ASSOCIATED(gto_basis_set%last_sgf)) DEALLOCATE (gto_basis_set%last_sgf)
203 IF (ASSOCIATED(gto_basis_set%n)) DEALLOCATE (gto_basis_set%n)
204 IF (ASSOCIATED(gto_basis_set%gcc)) DEALLOCATE (gto_basis_set%gcc)
205 DEALLOCATE (gto_basis_set)
206 END IF
207 END SUBROUTINE deallocate_gto_basis_set
208
209! **************************************************************************************************
210!> \brief ...
211!> \param basis_set_in ...
212!> \param basis_set_out ...
213! **************************************************************************************************
214 SUBROUTINE copy_gto_basis_set(basis_set_in, basis_set_out)
215
216 ! Copy a Gaussian-type orbital (GTO) basis set data set.
217
218 TYPE(gto_basis_set_type), INTENT(IN) :: basis_set_in
219 TYPE(gto_basis_set_type), POINTER :: basis_set_out
220
221 INTEGER :: maxco, maxpgf, maxshell, ncgf, nset, nsgf
222
223 CALL allocate_gto_basis_set(basis_set_out)
224
225 basis_set_out%name = basis_set_in%name
226 basis_set_out%aliases = basis_set_in%aliases
227 basis_set_out%kind_radius = basis_set_in%kind_radius
228 basis_set_out%norm_type = basis_set_in%norm_type
229 basis_set_out%nset = basis_set_in%nset
230 basis_set_out%ncgf = basis_set_in%ncgf
231 basis_set_out%nsgf = basis_set_in%nsgf
232 nset = basis_set_in%nset
233 ncgf = basis_set_in%ncgf
234 nsgf = basis_set_in%nsgf
235 ALLOCATE (basis_set_out%cgf_symbol(ncgf))
236 ALLOCATE (basis_set_out%sgf_symbol(nsgf))
237 basis_set_out%cgf_symbol = basis_set_in%cgf_symbol
238 basis_set_out%sgf_symbol = basis_set_in%sgf_symbol
239 ALLOCATE (basis_set_out%norm_cgf(ncgf))
240 basis_set_out%norm_cgf = basis_set_in%norm_cgf
241 ALLOCATE (basis_set_out%set_radius(nset))
242 basis_set_out%set_radius = basis_set_in%set_radius
243 ALLOCATE (basis_set_out%lmax(nset), basis_set_out%lmin(nset), basis_set_out%npgf(nset), basis_set_out%nshell(nset))
244 basis_set_out%lmax = basis_set_in%lmax
245 basis_set_out%lmin = basis_set_in%lmin
246 basis_set_out%npgf = basis_set_in%npgf
247 basis_set_out%nshell = basis_set_in%nshell
248 ALLOCATE (basis_set_out%lx(ncgf), basis_set_out%ly(ncgf), basis_set_out%lz(ncgf), basis_set_out%m(nsgf))
249 basis_set_out%lx = basis_set_in%lx
250 basis_set_out%ly = basis_set_in%ly
251 basis_set_out%lz = basis_set_in%lz
252 basis_set_out%m = basis_set_in%m
253 ALLOCATE (basis_set_out%ncgf_set(nset), basis_set_out%nsgf_set(nset))
254 basis_set_out%ncgf_set = basis_set_in%ncgf_set
255 basis_set_out%nsgf_set = basis_set_in%nsgf_set
256 maxco = SIZE(basis_set_in%cphi, 1)
257 ALLOCATE (basis_set_out%cphi(maxco, ncgf), basis_set_out%sphi(maxco, nsgf), basis_set_out%scon(maxco, nsgf))
258 ALLOCATE (basis_set_out%ccon(maxco, ncgf))
259 basis_set_out%cphi = basis_set_in%cphi
260 basis_set_out%sphi = basis_set_in%sphi
261 basis_set_out%scon = basis_set_in%scon
262 basis_set_out%ccon = 0.0_dp
263 IF (ASSOCIATED(basis_set_in%ccon)) THEN
264 IF ((SIZE(basis_set_in%ccon, 1) == maxco) .AND. (SIZE(basis_set_in%ccon, 2) == ncgf)) THEN
265 basis_set_out%ccon = basis_set_in%ccon
266 END IF
267 END IF
268 maxpgf = maxval(basis_set_in%npgf)
269 ALLOCATE (basis_set_out%pgf_radius(maxpgf, nset), basis_set_out%zet(maxpgf, nset))
270 basis_set_out%pgf_radius = basis_set_in%pgf_radius
271 basis_set_out%zet = basis_set_in%zet
272 maxshell = maxval(basis_set_in%nshell)
273 ALLOCATE (basis_set_out%first_cgf(maxshell, nset), basis_set_out%first_sgf(maxshell, nset))
274 ALLOCATE (basis_set_out%last_cgf(maxshell, nset), basis_set_out%last_sgf(maxshell, nset))
275 basis_set_out%first_cgf = basis_set_in%first_cgf
276 basis_set_out%first_sgf = basis_set_in%first_sgf
277 basis_set_out%last_cgf = basis_set_in%last_cgf
278 basis_set_out%last_sgf = basis_set_in%last_sgf
279 ALLOCATE (basis_set_out%n(maxshell, nset), basis_set_out%l(maxshell, nset))
280 basis_set_out%n = basis_set_in%n
281 basis_set_out%l = basis_set_in%l
282 ALLOCATE (basis_set_out%gcc(maxpgf, maxshell, nset))
283 basis_set_out%gcc = basis_set_in%gcc
284
285 END SUBROUTINE copy_gto_basis_set
286
287! **************************************************************************************************
288!> \brief ...
289!> \param basis_set ...
290!> \param pbasis ...
291!> \param lmax ...
292! **************************************************************************************************
293 SUBROUTINE create_primitive_basis_set(basis_set, pbasis, lmax)
294
295 ! Create a primitives only basis set
296
297 TYPE(gto_basis_set_type), INTENT(IN) :: basis_set
298 TYPE(gto_basis_set_type), POINTER :: pbasis
299 INTEGER, INTENT(IN), OPTIONAL :: lmax
300
301 INTEGER :: i, ico, ip, ipgf, iset, ishell, l, lm, &
302 lshell, m, maxco, mpgf, nc, ncgf, ns, &
303 nset, nsgf
304 INTEGER, ALLOCATABLE, DIMENSION(:) :: nindex, nprim
305 REAL(kind=dp) :: zet0
306 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: zet, zeta
307
308 mpgf = sum(basis_set%npgf)
309 lm = maxval(basis_set%lmax)
310 ALLOCATE (zet(mpgf, 0:lm), zeta(mpgf, lm + 1), nindex(mpgf), nprim(0:lm))
311 zet = 0.0_dp
312 zeta = 0.0_dp
313 DO l = 0, lm
314 ip = 0
315 DO iset = 1, basis_set%nset
316 IF (basis_set%lmin(iset) <= l .AND. basis_set%lmax(iset) >= l) THEN
317 DO ipgf = 1, basis_set%npgf(iset)
318 ip = ip + 1
319 zet(ip, l) = basis_set%zet(ipgf, iset)
320 END DO
321 END IF
322 END DO
323 nprim(l) = ip
324 END DO
325
326 ! sort exponents
327 DO l = 0, lm
328 zet(1:nprim(l), l) = -zet(1:nprim(l), l)
329 CALL sort(zet(1:nprim(l), l), nprim(l), nindex)
330 ! remove duplicates
331 ip = 0
332 zet0 = 0.0_dp
333 DO i = 1, nprim(l)
334 IF (abs(zet0 - zet(i, l)) > 1.e-6_dp) THEN
335 ip = ip + 1
336 zeta(ip, l + 1) = zet(i, l)
337 END IF
338 END DO
339 nprim(l) = ip
340 !
341 zeta(1:ip, l + 1) = -zeta(1:ip, l + 1)
342 END DO
343
344 CALL allocate_gto_basis_set(pbasis)
345
346 IF (PRESENT(lmax)) THEN
347 ! if requested, reduce max l val
348 lm = min(lm, lmax)
349 END IF
350
351 IF (len_trim(basis_set%name) + 10 > default_string_length) THEN
352 cpwarn("The name of the primitive basis set will be truncated.")
353 END IF
354 pbasis%name = trim(basis_set%name)//"_primitive"
355 pbasis%kind_radius = basis_set%kind_radius
356 pbasis%short_kind_radius = basis_set%short_kind_radius
357 pbasis%norm_type = basis_set%norm_type
358 nset = lm + 1
359 pbasis%nset = nset
360 ALLOCATE (pbasis%lmax(nset), pbasis%lmin(nset), pbasis%npgf(nset), pbasis%nshell(nset))
361 DO iset = 1, nset
362 pbasis%lmax(iset) = iset - 1
363 pbasis%lmin(iset) = iset - 1
364 pbasis%npgf(iset) = nprim(iset - 1)
365 pbasis%nshell(iset) = nprim(iset - 1)
366 END DO
367 pbasis%ncgf = 0
368 pbasis%nsgf = 0
369 DO l = 0, lm
370 pbasis%ncgf = pbasis%ncgf + nprim(l)*((l + 1)*(l + 2))/2
371 pbasis%nsgf = pbasis%nsgf + nprim(l)*(2*l + 1)
372 END DO
373 mpgf = maxval(nprim)
374 ALLOCATE (pbasis%zet(mpgf, nset))
375 pbasis%zet(1:mpgf, 1:nset) = zeta(1:mpgf, 1:nset)
376
377 ALLOCATE (pbasis%l(mpgf, nset), pbasis%n(mpgf, nset))
378 DO iset = 1, nset
379 DO ip = 1, nprim(iset - 1)
380 pbasis%l(ip, iset) = iset - 1
381 pbasis%n(ip, iset) = iset + ip - 1
382 END DO
383 END DO
384
385 ALLOCATE (pbasis%cgf_symbol(pbasis%ncgf))
386 ALLOCATE (pbasis%lx(pbasis%ncgf))
387 ALLOCATE (pbasis%ly(pbasis%ncgf))
388 ALLOCATE (pbasis%lz(pbasis%ncgf))
389 ALLOCATE (pbasis%m(pbasis%nsgf))
390 ALLOCATE (pbasis%sgf_symbol(pbasis%nsgf))
391 ALLOCATE (pbasis%ncgf_set(nset), pbasis%nsgf_set(nset))
392
393 ncgf = 0
394 nsgf = 0
395 DO iset = 1, nset
396 l = iset - 1
397 pbasis%ncgf_set(iset) = nprim(l)*((l + 1)*(l + 2))/2
398 pbasis%nsgf_set(iset) = nprim(l)*(2*l + 1)
399 DO ishell = 1, pbasis%nshell(iset)
400 lshell = pbasis%l(ishell, iset)
401 DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
402 ncgf = ncgf + 1
403 pbasis%lx(ncgf) = indco(1, ico)
404 pbasis%ly(ncgf) = indco(2, ico)
405 pbasis%lz(ncgf) = indco(3, ico)
406 pbasis%cgf_symbol(ncgf) = &
407 cgf_symbol(pbasis%n(ishell, iset), [pbasis%lx(ncgf), pbasis%ly(ncgf), pbasis%lz(ncgf)])
408 END DO
409 DO m = -lshell, lshell
410 nsgf = nsgf + 1
411 pbasis%m(nsgf) = m
412 pbasis%sgf_symbol(nsgf) = sgf_symbol(pbasis%n(ishell, iset), lshell, m)
413 END DO
414 END DO
415 END DO
416 cpassert(ncgf == pbasis%ncgf)
417 cpassert(nsgf == pbasis%nsgf)
418
419 ALLOCATE (pbasis%gcc(mpgf, mpgf, nset))
420 pbasis%gcc = 0.0_dp
421 DO iset = 1, nset
422 DO i = 1, mpgf
423 pbasis%gcc(i, i, iset) = 1.0_dp
424 END DO
425 END DO
426
427 ALLOCATE (pbasis%first_cgf(mpgf, nset))
428 ALLOCATE (pbasis%first_sgf(mpgf, nset))
429 ALLOCATE (pbasis%last_cgf(mpgf, nset))
430 ALLOCATE (pbasis%last_sgf(mpgf, nset))
431 nc = 0
432 ns = 0
433 maxco = 0
434 DO iset = 1, nset
435 DO ishell = 1, pbasis%nshell(iset)
436 lshell = pbasis%l(ishell, iset)
437 pbasis%first_cgf(ishell, iset) = nc + 1
438 nc = nc + nco(lshell)
439 pbasis%last_cgf(ishell, iset) = nc
440 pbasis%first_sgf(ishell, iset) = ns + 1
441 ns = ns + nso(lshell)
442 pbasis%last_sgf(ishell, iset) = ns
443 END DO
444 maxco = max(maxco, pbasis%npgf(iset)*ncoset(pbasis%lmax(iset)))
445 END DO
446
447 ALLOCATE (pbasis%norm_cgf(ncgf))
448 ALLOCATE (pbasis%cphi(maxco, ncgf))
449 pbasis%cphi = 0.0_dp
450 ALLOCATE (pbasis%sphi(maxco, nsgf))
451 pbasis%sphi = 0.0_dp
452 ALLOCATE (pbasis%scon(maxco, ncgf))
453 pbasis%scon = 0.0_dp
454 ALLOCATE (pbasis%ccon(maxco, ncgf))
455 pbasis%ccon = 0.0_dp
456 ALLOCATE (pbasis%set_radius(nset))
457 ALLOCATE (pbasis%pgf_radius(mpgf, nset))
458 pbasis%pgf_radius = 0.0_dp
459
460 CALL init_orb_basis_set(pbasis)
461
462 DEALLOCATE (zet, zeta, nindex, nprim)
463
464 END SUBROUTINE create_primitive_basis_set
465
466! **************************************************************************************************
467!> \brief ...
468!> \param basis_set ...
469!> \param basis_set_add ...
470! **************************************************************************************************
471 SUBROUTINE combine_basis_sets(basis_set, basis_set_add)
472
473 ! Combine two Gaussian-type orbital (GTO) basis sets.
474
475 TYPE(gto_basis_set_type), INTENT(INOUT) :: basis_set
476 TYPE(gto_basis_set_type), INTENT(IN) :: basis_set_add
477
478 CHARACTER(LEN=12), DIMENSION(:), POINTER :: cgf_symbol
479 CHARACTER(LEN=6), DIMENSION(:), POINTER :: sgf_symbol
480 INTEGER :: iset, ishell, lshell, maxco, maxpgf, &
481 maxshell, nc, ncgf, ncgfn, ncgfo, ns, &
482 nset, nsetn, nseto, nsgf, nsgfn, nsgfo
483
484 IF (len_trim(basis_set%name) + len_trim(basis_set_add%name) > default_string_length) THEN
485 cpwarn("The name of the combined GTO basis set will be truncated.")
486 END IF
487 basis_set%name = trim(basis_set%name)//trim(basis_set_add%name)
488 basis_set%nset = basis_set%nset + basis_set_add%nset
489 basis_set%ncgf = basis_set%ncgf + basis_set_add%ncgf
490 basis_set%nsgf = basis_set%nsgf + basis_set_add%nsgf
491 nset = basis_set%nset
492 ncgf = basis_set%ncgf
493 nsgf = basis_set%nsgf
494
495 nsetn = basis_set_add%nset
496 nseto = nset - nsetn
497 CALL reallocate(basis_set%set_radius, 1, nset) ! to be defined later
498 CALL reallocate(basis_set%lmax, 1, nset)
499 CALL reallocate(basis_set%lmin, 1, nset)
500 CALL reallocate(basis_set%npgf, 1, nset)
501 CALL reallocate(basis_set%nshell, 1, nset)
502 basis_set%lmax(nseto + 1:nset) = basis_set_add%lmax(1:nsetn)
503 basis_set%lmin(nseto + 1:nset) = basis_set_add%lmin(1:nsetn)
504 basis_set%npgf(nseto + 1:nset) = basis_set_add%npgf(1:nsetn)
505 basis_set%nshell(nseto + 1:nset) = basis_set_add%nshell(1:nsetn)
506 CALL reallocate(basis_set%ncgf_set, 1, nset)
507 CALL reallocate(basis_set%nsgf_set, 1, nset)
508 basis_set%ncgf_set(nseto + 1:nset) = basis_set_add%ncgf_set(1:nsetn)
509 basis_set%nsgf_set(nseto + 1:nset) = basis_set_add%nsgf_set(1:nsetn)
510
511 nsgfn = basis_set_add%nsgf
512 nsgfo = nsgf - nsgfn
513 ncgfn = basis_set_add%ncgf
514 ncgfo = ncgf - ncgfn
515
516 ALLOCATE (cgf_symbol(ncgf), sgf_symbol(nsgf))
517 cgf_symbol(1:ncgfo) = basis_set%cgf_symbol(1:ncgfo)
518 cgf_symbol(ncgfo + 1:ncgf) = basis_set_add%cgf_symbol(1:ncgfn)
519 sgf_symbol(1:nsgfo) = basis_set%sgf_symbol(1:nsgfo)
520 sgf_symbol(nsgfo + 1:nsgf) = basis_set_add%sgf_symbol(1:nsgfn)
521 DEALLOCATE (basis_set%cgf_symbol, basis_set%sgf_symbol)
522 ALLOCATE (basis_set%cgf_symbol(ncgf), basis_set%sgf_symbol(nsgf))
523 basis_set%cgf_symbol = cgf_symbol
524 basis_set%sgf_symbol = sgf_symbol
525 DEALLOCATE (cgf_symbol, sgf_symbol)
526
527 CALL reallocate(basis_set%lx, 1, ncgf)
528 CALL reallocate(basis_set%ly, 1, ncgf)
529 CALL reallocate(basis_set%lz, 1, ncgf)
530 CALL reallocate(basis_set%m, 1, nsgf)
531 basis_set%lx(ncgfo + 1:ncgf) = basis_set_add%lx(1:ncgfn)
532 basis_set%ly(ncgfo + 1:ncgf) = basis_set_add%ly(1:ncgfn)
533 basis_set%lz(ncgfo + 1:ncgf) = basis_set_add%lz(1:ncgfn)
534 basis_set%m(nsgfo + 1:nsgf) = basis_set_add%m(1:nsgfn)
535
536 maxpgf = maxval(basis_set%npgf)
537 CALL reallocate(basis_set%zet, 1, maxpgf, 1, nset)
538 nc = SIZE(basis_set_add%zet, 1)
539 DO iset = 1, nsetn
540 basis_set%zet(1:nc, nseto + iset) = basis_set_add%zet(1:nc, iset)
541 END DO
542
543 maxshell = maxval(basis_set%nshell)
544 CALL reallocate(basis_set%l, 1, maxshell, 1, nset)
545 CALL reallocate(basis_set%n, 1, maxshell, 1, nset)
546 nc = SIZE(basis_set_add%l, 1)
547 DO iset = 1, nsetn
548 basis_set%l(1:nc, nseto + iset) = basis_set_add%l(1:nc, iset)
549 basis_set%n(1:nc, nseto + iset) = basis_set_add%n(1:nc, iset)
550 END DO
551
552 CALL reallocate(basis_set%first_cgf, 1, maxshell, 1, nset)
553 CALL reallocate(basis_set%first_sgf, 1, maxshell, 1, nset)
554 CALL reallocate(basis_set%last_cgf, 1, maxshell, 1, nset)
555 CALL reallocate(basis_set%last_sgf, 1, maxshell, 1, nset)
556 nc = 0
557 ns = 0
558 DO iset = 1, nset
559 DO ishell = 1, basis_set%nshell(iset)
560 lshell = basis_set%l(ishell, iset)
561 basis_set%first_cgf(ishell, iset) = nc + 1
562 nc = nc + nco(lshell)
563 basis_set%last_cgf(ishell, iset) = nc
564 basis_set%first_sgf(ishell, iset) = ns + 1
565 ns = ns + nso(lshell)
566 basis_set%last_sgf(ishell, iset) = ns
567 END DO
568 END DO
569
570 CALL reallocate(basis_set%gcc, 1, maxpgf, 1, maxshell, 1, nset)
571 nc = SIZE(basis_set_add%gcc, 1)
572 ns = SIZE(basis_set_add%gcc, 2)
573 DO iset = 1, nsetn
574 basis_set%gcc(1:nc, 1:ns, nseto + iset) = basis_set_add%gcc(1:nc, 1:ns, iset)
575 END DO
576
577 ! these arrays are determined later using initialization calls
578 CALL reallocate(basis_set%norm_cgf, 1, ncgf)
579 maxco = max(SIZE(basis_set%cphi, 1), SIZE(basis_set_add%cphi, 1))
580 CALL reallocate(basis_set%cphi, 1, maxco, 1, ncgf)
581 CALL reallocate(basis_set%sphi, 1, maxco, 1, nsgf)
582 CALL reallocate(basis_set%scon, 1, maxco, 1, nsgf)
583 CALL reallocate(basis_set%ccon, 1, maxco, 1, ncgf)
584 CALL reallocate(basis_set%pgf_radius, 1, maxpgf, 1, nset)
585
586 END SUBROUTINE combine_basis_sets
587
588! **************************************************************************************************
589!> \brief ...
590!> \param gto_basis_set ...
591!> \param name ...
592!> \param aliases ...
593!> \param norm_type ...
594!> \param kind_radius ...
595!> \param ncgf ...
596!> \param nset ...
597!> \param nsgf ...
598!> \param cgf_symbol ...
599!> \param sgf_symbol ...
600!> \param norm_cgf ...
601!> \param set_radius ...
602!> \param lmax ...
603!> \param lmin ...
604!> \param lx ...
605!> \param ly ...
606!> \param lz ...
607!> \param m ...
608!> \param ncgf_set ...
609!> \param npgf ...
610!> \param nsgf_set ...
611!> \param nshell ...
612!> \param cphi ...
613!> \param pgf_radius ...
614!> \param sphi ...
615!> \param scon ...
616!> \param zet ...
617!> \param first_cgf ...
618!> \param first_sgf ...
619!> \param l ...
620!> \param last_cgf ...
621!> \param last_sgf ...
622!> \param n ...
623!> \param gcc ...
624!> \param maxco ...
625!> \param maxl ...
626!> \param maxpgf ...
627!> \param maxsgf_set ...
628!> \param maxshell ...
629!> \param maxso ...
630!> \param nco_sum ...
631!> \param npgf_sum ...
632!> \param nshell_sum ...
633!> \param maxder ...
634!> \param short_kind_radius ...
635!> \param npgf_seg_sum number of primitives in "segmented contraction format"
636!> \param ccon ...
637! **************************************************************************************************
638 SUBROUTINE get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, &
639 nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, &
640 m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, &
641 last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, &
642 npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum, ccon)
643
644 ! Get informations about a Gaussian-type orbital (GTO) basis set.
645
646 ! - Creation (10.01.2002,MK)
647
648 TYPE(gto_basis_set_type), INTENT(IN) :: gto_basis_set
649 CHARACTER(LEN=default_string_length), &
650 INTENT(OUT), OPTIONAL :: name, aliases
651 INTEGER, INTENT(OUT), OPTIONAL :: norm_type
652 REAL(kind=dp), INTENT(OUT), OPTIONAL :: kind_radius
653 INTEGER, INTENT(OUT), OPTIONAL :: ncgf, nset, nsgf
654 CHARACTER(LEN=12), DIMENSION(:), OPTIONAL, POINTER :: cgf_symbol
655 CHARACTER(LEN=6), DIMENSION(:), OPTIONAL, POINTER :: sgf_symbol
656 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: norm_cgf, set_radius
657 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: lmax, lmin, lx, ly, lz, m, ncgf_set, &
658 npgf, nsgf_set, nshell
659 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cphi, pgf_radius, sphi, scon, zet
660 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: first_cgf, first_sgf, l, last_cgf, &
661 last_sgf, n
662 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
663 POINTER :: gcc
664 INTEGER, INTENT(OUT), OPTIONAL :: maxco, maxl, maxpgf, maxsgf_set, &
665 maxshell, maxso, nco_sum, npgf_sum, &
666 nshell_sum
667 INTEGER, INTENT(IN), OPTIONAL :: maxder
668 REAL(kind=dp), INTENT(OUT), OPTIONAL :: short_kind_radius
669 INTEGER, INTENT(OUT), OPTIONAL :: npgf_seg_sum
670 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: ccon
671
672 INTEGER :: iset, nder
673
674 IF (PRESENT(name)) name = gto_basis_set%name
675 IF (PRESENT(aliases)) aliases = gto_basis_set%aliases
676 IF (PRESENT(norm_type)) norm_type = gto_basis_set%norm_type
677 IF (PRESENT(kind_radius)) kind_radius = gto_basis_set%kind_radius
678 IF (PRESENT(short_kind_radius)) short_kind_radius = gto_basis_set%short_kind_radius
679 IF (PRESENT(ncgf)) ncgf = gto_basis_set%ncgf
680 IF (PRESENT(nset)) nset = gto_basis_set%nset
681 IF (PRESENT(nsgf)) nsgf = gto_basis_set%nsgf
682 IF (PRESENT(cgf_symbol)) cgf_symbol => gto_basis_set%cgf_symbol
683 IF (PRESENT(sgf_symbol)) sgf_symbol => gto_basis_set%sgf_symbol
684 IF (PRESENT(norm_cgf)) norm_cgf => gto_basis_set%norm_cgf
685 IF (PRESENT(set_radius)) set_radius => gto_basis_set%set_radius
686 IF (PRESENT(lmax)) lmax => gto_basis_set%lmax
687 IF (PRESENT(lmin)) lmin => gto_basis_set%lmin
688 IF (PRESENT(lx)) lx => gto_basis_set%lx
689 IF (PRESENT(ly)) ly => gto_basis_set%ly
690 IF (PRESENT(lz)) lz => gto_basis_set%lz
691 IF (PRESENT(m)) m => gto_basis_set%m
692 IF (PRESENT(ncgf_set)) ncgf_set => gto_basis_set%ncgf_set
693 IF (PRESENT(npgf)) npgf => gto_basis_set%npgf
694 IF (PRESENT(nsgf_set)) nsgf_set => gto_basis_set%nsgf_set
695 IF (PRESENT(nshell)) nshell => gto_basis_set%nshell
696 IF (PRESENT(cphi)) cphi => gto_basis_set%cphi
697 IF (PRESENT(pgf_radius)) pgf_radius => gto_basis_set%pgf_radius
698 IF (PRESENT(sphi)) sphi => gto_basis_set%sphi
699 IF (PRESENT(scon)) scon => gto_basis_set%scon
700 IF (PRESENT(ccon)) ccon => gto_basis_set%ccon
701 IF (PRESENT(zet)) zet => gto_basis_set%zet
702 IF (PRESENT(first_cgf)) first_cgf => gto_basis_set%first_cgf
703 IF (PRESENT(first_sgf)) first_sgf => gto_basis_set%first_sgf
704 IF (PRESENT(l)) l => gto_basis_set%l
705 IF (PRESENT(last_cgf)) last_cgf => gto_basis_set%last_cgf
706 IF (PRESENT(last_sgf)) last_sgf => gto_basis_set%last_sgf
707 IF (PRESENT(n)) n => gto_basis_set%n
708 IF (PRESENT(gcc)) gcc => gto_basis_set%gcc
709 IF (PRESENT(maxco)) THEN
710 maxco = 0
711 IF (PRESENT(maxder)) THEN
712 nder = maxder
713 ELSE
714 nder = 0
715 END IF
716 DO iset = 1, gto_basis_set%nset
717 maxco = max(maxco, gto_basis_set%npgf(iset)* &
718 ncoset(gto_basis_set%lmax(iset) + nder))
719 END DO
720 END IF
721 IF (PRESENT(maxl)) THEN
722 maxl = -1
723 DO iset = 1, gto_basis_set%nset
724 maxl = max(maxl, gto_basis_set%lmax(iset))
725 END DO
726 END IF
727 IF (PRESENT(maxpgf)) THEN
728 maxpgf = 0
729 DO iset = 1, gto_basis_set%nset
730 maxpgf = max(maxpgf, gto_basis_set%npgf(iset))
731 END DO
732 END IF
733 IF (PRESENT(maxsgf_set)) THEN
734 maxsgf_set = 0
735 DO iset = 1, gto_basis_set%nset
736 maxsgf_set = max(maxsgf_set, gto_basis_set%nsgf_set(iset))
737 END DO
738 END IF
739 IF (PRESENT(maxshell)) THEN ! MAXVAL on structure component avoided
740 maxshell = 0
741 DO iset = 1, gto_basis_set%nset
742 maxshell = max(maxshell, gto_basis_set%nshell(iset))
743 END DO
744 END IF
745 IF (PRESENT(maxso)) THEN
746 maxso = 0
747 DO iset = 1, gto_basis_set%nset
748 maxso = max(maxso, gto_basis_set%npgf(iset)* &
749 nsoset(gto_basis_set%lmax(iset)))
750 END DO
751 END IF
752
753 IF (PRESENT(nco_sum)) THEN
754 nco_sum = 0
755 DO iset = 1, gto_basis_set%nset
756 nco_sum = nco_sum + gto_basis_set%npgf(iset)* &
757 ncoset(gto_basis_set%lmax(iset))
758 END DO
759 END IF
760 IF (PRESENT(npgf_sum)) npgf_sum = sum(gto_basis_set%npgf)
761 IF (PRESENT(nshell_sum)) nshell_sum = sum(gto_basis_set%nshell)
762 IF (PRESENT(npgf_seg_sum)) THEN
763 npgf_seg_sum = 0
764 DO iset = 1, gto_basis_set%nset
765 npgf_seg_sum = npgf_seg_sum + gto_basis_set%npgf(iset)*gto_basis_set%nshell(iset)
766 END DO
767 END IF
768
769 END SUBROUTINE get_gto_basis_set
770
771! **************************************************************************************************
772!> \brief ...
773!> \param gto_basis_set ...
774! **************************************************************************************************
775 SUBROUTINE init_aux_basis_set(gto_basis_set)
776
777 ! Initialise a Gaussian-type orbital (GTO) basis set data set.
778
779 ! - Creation (06.12.2000,MK)
780
781 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
782
783 CHARACTER(len=*), PARAMETER :: routinen = 'init_aux_basis_set'
784
785 INTEGER :: handle
786
787! -------------------------------------------------------------------------
788
789 IF (.NOT. ASSOCIATED(gto_basis_set)) RETURN
790
791 CALL timeset(routinen, handle)
792
793 SELECT CASE (gto_basis_set%norm_type)
794 CASE (0)
795 ! No normalisation requested
796 CASE (1)
797 CALL init_norm_cgf_aux_2(gto_basis_set)
798 CASE (2)
799 ! WARNING this was never tested
800 CALL init_norm_cgf_aux(gto_basis_set)
801 CASE DEFAULT
802 cpabort("Normalization method not specified")
803 END SELECT
804
805 ! Initialise the transformation matrices "pgf" -> "cgf"
806 CALL init_cphi_and_sphi(gto_basis_set, .false.)
807
808 CALL timestop(handle)
809
810 END SUBROUTINE init_aux_basis_set
811
812! **************************************************************************************************
813!> \brief ...
814!> \param gto_basis_set ...
815!> \param lccon ...
816! **************************************************************************************************
817 SUBROUTINE init_cphi_and_sphi(gto_basis_set, lccon)
818
819 ! Initialise the matrices for the transformation of primitive Cartesian
820 ! Gaussian-type functions to contracted Cartesian (cphi) and spherical
821 ! (sphi) Gaussian-type functions.
822
823 ! - Creation (20.09.2000,MK)
824
825 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
826 LOGICAL, INTENT(IN), OPTIONAL :: lccon
827
828 CHARACTER(len=*), PARAMETER :: routinen = 'init_cphi_and_sphi'
829
830 INTEGER :: first_cgf, first_sgf, handle, icgf, ico, &
831 ipgf, iset, ishell, l, last_sgf, lmax, &
832 lmin, n, n1, n2, ncgf, nn, nn1, nn2, &
833 npgf, nsgf
834 LOGICAL :: my_lccon
835
836 my_lccon = .false.
837 IF (PRESENT(lccon)) my_lccon = lccon
838! -------------------------------------------------------------------------
839! Build the Cartesian transformation matrix "cphi"
840
841 CALL timeset(routinen, handle)
842
843 gto_basis_set%cphi = 0.0_dp
844 DO iset = 1, gto_basis_set%nset
845 n = ncoset(gto_basis_set%lmax(iset))
846 DO ishell = 1, gto_basis_set%nshell(iset)
847 DO icgf = gto_basis_set%first_cgf(ishell, iset), &
848 gto_basis_set%last_cgf(ishell, iset)
849 ico = coset(gto_basis_set%lx(icgf), &
850 gto_basis_set%ly(icgf), &
851 gto_basis_set%lz(icgf))
852 DO ipgf = 1, gto_basis_set%npgf(iset)
853 gto_basis_set%cphi(ico, icgf) = gto_basis_set%norm_cgf(icgf)* &
854 gto_basis_set%gcc(ipgf, ishell, iset)
855 ico = ico + n
856 END DO
857 END DO
858 END DO
859 END DO
860
861 ! Build the spherical transformation matrix "sphi"
862
863 n = SIZE(gto_basis_set%cphi, 1)
864
865 gto_basis_set%sphi = 0.0_dp
866 IF (n > 0) THEN
867 lmax = -1
868 ! Ensure proper setup of orbtramat
869 DO iset = 1, gto_basis_set%nset
870 DO ishell = 1, gto_basis_set%nshell(iset)
871 lmax = max(lmax, gto_basis_set%l(ishell, iset))
872 END DO
873 END DO
874 CALL init_spherical_harmonics(lmax, -1)
875
876 DO iset = 1, gto_basis_set%nset
877 DO ishell = 1, gto_basis_set%nshell(iset)
878 l = gto_basis_set%l(ishell, iset)
879 first_cgf = gto_basis_set%first_cgf(ishell, iset)
880 first_sgf = gto_basis_set%first_sgf(ishell, iset)
881 ncgf = nco(l)
882 nsgf = nso(l)
883 CALL dgemm("N", "T", n, nsgf, ncgf, &
884 1.0_dp, gto_basis_set%cphi(1, first_cgf), n, &
885 orbtramat(l)%c2s(1, 1), nsgf, &
886 0.0_dp, gto_basis_set%sphi(1, first_sgf), n)
887 END DO
888 END DO
889 END IF
890
891 ! Build the reduced transformation matrix "scon"
892 ! This matrix transforms from cartesian primitifs to spherical contracted functions
893 ! "scon" only includes primitifs (lmin -> lmax), whereas sphi is (0 -> lmax)
894
895 n = SIZE(gto_basis_set%scon, 1)
896
897 gto_basis_set%scon = 0.0_dp
898 IF (n > 0) THEN
899 DO iset = 1, gto_basis_set%nset
900 lmin = gto_basis_set%lmin(iset)
901 lmax = gto_basis_set%lmax(iset)
902 npgf = gto_basis_set%npgf(iset)
903 nn = ncoset(lmax) - ncoset(lmin - 1)
904 DO ishell = 1, gto_basis_set%nshell(iset)
905 first_sgf = gto_basis_set%first_sgf(ishell, iset)
906 last_sgf = gto_basis_set%last_sgf(ishell, iset)
907 DO ipgf = 1, npgf
908 nn1 = (ipgf - 1)*ncoset(lmax) + ncoset(lmin - 1) + 1
909 nn2 = ipgf*ncoset(lmax)
910 n1 = (ipgf - 1)*nn + 1
911 n2 = ipgf*nn
912 gto_basis_set%scon(n1:n2, first_sgf:last_sgf) = gto_basis_set%sphi(nn1:nn2, first_sgf:last_sgf)
913 END DO
914 END DO
915 END DO
916 END IF
917
918 IF (my_lccon) THEN
919 IF (.NOT. ASSOCIATED(gto_basis_set%ccon)) THEN
920 CALL reallocate(gto_basis_set%ccon, 1, SIZE(gto_basis_set%cphi, 1), 1, gto_basis_set%ncgf)
921 ELSE IF ((SIZE(gto_basis_set%ccon, 1) /= SIZE(gto_basis_set%cphi, 1)) .OR. &
922 (SIZE(gto_basis_set%ccon, 2) /= gto_basis_set%ncgf)) THEN
923 CALL reallocate(gto_basis_set%ccon, 1, SIZE(gto_basis_set%cphi, 1), 1, gto_basis_set%ncgf)
924 END IF
925 n = SIZE(gto_basis_set%ccon, 1)
926 gto_basis_set%ccon = 0.0_dp
927 IF (n > 0) THEN
928 DO iset = 1, gto_basis_set%nset
929 lmin = gto_basis_set%lmin(iset)
930 lmax = gto_basis_set%lmax(iset)
931 npgf = gto_basis_set%npgf(iset)
932 nn = ncoset(lmax) - ncoset(lmin - 1)
933 DO ishell = 1, gto_basis_set%nshell(iset)
934 first_sgf = gto_basis_set%first_cgf(ishell, iset)
935 last_sgf = gto_basis_set%last_cgf(ishell, iset)
936 DO ipgf = 1, npgf
937 nn1 = (ipgf - 1)*ncoset(lmax) + ncoset(lmin - 1) + 1
938 nn2 = ipgf*ncoset(lmax)
939 n1 = (ipgf - 1)*nn + 1
940 n2 = ipgf*nn
941 gto_basis_set%ccon(n1:n2, first_sgf:last_sgf) = gto_basis_set%cphi(nn1:nn2, first_sgf:last_sgf)
942 END DO
943 END DO
944 END DO
945 END IF
946 END IF
947
948 CALL timestop(handle)
949
950 END SUBROUTINE init_cphi_and_sphi
951
952! **************************************************************************************************
953!> \brief ...
954!> \param gto_basis_set ...
955! **************************************************************************************************
956 SUBROUTINE init_norm_cgf_aux(gto_basis_set)
957
958 ! Initialise the normalization factors of the contracted Cartesian Gaussian
959 ! functions, if the Gaussian functions represent charge distributions.
960
961 ! - Creation (07.12.2000,MK)
962
963 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
964
965 INTEGER :: icgf, ico, ipgf, iset, ishell, jco, &
966 jpgf, ll, lmax, lmin, lx, ly, lz, n, &
967 npgfa
968 REAL(kind=dp) :: fnorm, gcca, gccb
969 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: ff
970 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: gaa
971 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: vv
972 REAL(kind=dp), DIMENSION(:), POINTER :: rpgfa, zeta
973
974! -------------------------------------------------------------------------
975
976 n = 0
977 ll = 0
978 DO iset = 1, gto_basis_set%nset
979 n = max(n, gto_basis_set%npgf(iset)*ncoset(gto_basis_set%lmax(iset)))
980 ll = max(ll, gto_basis_set%lmax(iset))
981 END DO
982
983 ALLOCATE (gaa(n, n))
984 ALLOCATE (vv(ncoset(ll), ncoset(ll), ll + ll + 1))
985 ALLOCATE (ff(0:ll + ll))
986
987 DO iset = 1, gto_basis_set%nset
988 lmax = gto_basis_set%lmax(iset)
989 lmin = gto_basis_set%lmin(iset)
990 n = ncoset(lmax)
991 npgfa = gto_basis_set%npgf(iset)
992 rpgfa => gto_basis_set%pgf_radius(1:npgfa, iset)
993 zeta => gto_basis_set%zet(1:npgfa, iset)
994 CALL coulomb2(lmax, npgfa, zeta, rpgfa, lmin, &
995 lmax, npgfa, zeta, rpgfa, lmin, &
996 [0.0_dp, 0.0_dp, 0.0_dp], 0.0_dp, gaa, vv, ff(0:))
997 DO ishell = 1, gto_basis_set%nshell(iset)
998 DO icgf = gto_basis_set%first_cgf(ishell, iset), &
999 gto_basis_set%last_cgf(ishell, iset)
1000 lx = gto_basis_set%lx(icgf)
1001 ly = gto_basis_set%ly(icgf)
1002 lz = gto_basis_set%lz(icgf)
1003 ico = coset(lx, ly, lz)
1004 fnorm = 0.0_dp
1005 DO ipgf = 1, npgfa
1006 gcca = gto_basis_set%gcc(ipgf, ishell, iset)
1007 jco = coset(lx, ly, lz)
1008 DO jpgf = 1, npgfa
1009 gccb = gto_basis_set%gcc(jpgf, ishell, iset)
1010 fnorm = fnorm + gcca*gccb*gaa(ico, jco)
1011 jco = jco + n
1012 END DO
1013 ico = ico + n
1014 END DO
1015 gto_basis_set%norm_cgf(icgf) = 1.0_dp/sqrt(fnorm)
1016 END DO
1017 END DO
1018 END DO
1019
1020 DEALLOCATE (vv, ff)
1021 DEALLOCATE (gaa)
1022
1023 END SUBROUTINE init_norm_cgf_aux
1024
1025! **************************************************************************************************
1026!> \brief ...
1027!> \param gto_basis_set ...
1028! **************************************************************************************************
1029 ELEMENTAL SUBROUTINE init_norm_cgf_aux_2(gto_basis_set)
1030
1031 ! Initialise the normalization factors of the auxiliary Cartesian Gaussian
1032 ! functions (Kim-Gordon polarization basis) Norm = 1.
1033
1034 ! - Creation (07.12.2000,GT)
1035
1036 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
1037
1038 INTEGER :: icgf, iset, ishell
1039
1040 DO iset = 1, gto_basis_set%nset
1041 DO ishell = 1, gto_basis_set%nshell(iset)
1042 DO icgf = gto_basis_set%first_cgf(ishell, iset), &
1043 gto_basis_set%last_cgf(ishell, iset)
1044 gto_basis_set%norm_cgf(icgf) = 1.0_dp
1045 END DO
1046 END DO
1047 END DO
1048
1049 END SUBROUTINE init_norm_cgf_aux_2
1050
1051! **************************************************************************************************
1052!> \brief Initialise the normalization factors of the contracted Cartesian Gaussian functions.
1053!> \param gto_basis_set ...
1054!> \author MK
1055! **************************************************************************************************
1056 ELEMENTAL SUBROUTINE init_norm_cgf_orb(gto_basis_set)
1057
1058 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
1059
1060 INTEGER :: icgf, ipgf, iset, ishell, jpgf, l, lx, &
1061 ly, lz
1062 REAL(kind=dp) :: expzet, fnorm, gcca, gccb, prefac, zeta, &
1063 zetb
1064
1065 DO iset = 1, gto_basis_set%nset
1066 DO ishell = 1, gto_basis_set%nshell(iset)
1067
1068 l = gto_basis_set%l(ishell, iset)
1069
1070 expzet = 0.5_dp*real(2*l + 3, dp)
1071
1072 fnorm = 0.0_dp
1073
1074 DO ipgf = 1, gto_basis_set%npgf(iset)
1075 gcca = gto_basis_set%gcc(ipgf, ishell, iset)
1076 zeta = gto_basis_set%zet(ipgf, iset)
1077 DO jpgf = 1, gto_basis_set%npgf(iset)
1078 gccb = gto_basis_set%gcc(jpgf, ishell, iset)
1079 zetb = gto_basis_set%zet(jpgf, iset)
1080 fnorm = fnorm + gcca*gccb/(zeta + zetb)**expzet
1081 END DO
1082 END DO
1083
1084 fnorm = 0.5_dp**l*pi**1.5_dp*fnorm
1085
1086 DO icgf = gto_basis_set%first_cgf(ishell, iset), &
1087 gto_basis_set%last_cgf(ishell, iset)
1088 lx = gto_basis_set%lx(icgf)
1089 ly = gto_basis_set%ly(icgf)
1090 lz = gto_basis_set%lz(icgf)
1091 prefac = dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)
1092 gto_basis_set%norm_cgf(icgf) = 1.0_dp/sqrt(prefac*fnorm)
1093 END DO
1094
1095 END DO
1096 END DO
1097
1098 END SUBROUTINE init_norm_cgf_orb
1099
1100! **************************************************************************************************
1101!> \brief Initialise the normalization factors of the contracted Cartesian Gaussian
1102!> functions used for frozen density representation.
1103!> \param gto_basis_set ...
1104!> \author GT
1105! **************************************************************************************************
1106 ELEMENTAL SUBROUTINE init_norm_cgf_orb_den(gto_basis_set)
1107
1108 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
1109
1110 INTEGER :: icgf, ipgf, iset, ishell, l
1111 REAL(kind=dp) :: expzet, gcca, prefac, zeta
1112
1113 DO iset = 1, gto_basis_set%nset
1114 DO ishell = 1, gto_basis_set%nshell(iset)
1115 l = gto_basis_set%l(ishell, iset)
1116 expzet = 0.5_dp*real(2*l + 3, dp)
1117 prefac = (1.0_dp/pi)**1.5_dp
1118 DO ipgf = 1, gto_basis_set%npgf(iset)
1119 gcca = gto_basis_set%gcc(ipgf, ishell, iset)
1120 zeta = gto_basis_set%zet(ipgf, iset)
1121 gto_basis_set%gcc(ipgf, ishell, iset) = prefac*zeta**expzet*gcca
1122 END DO
1123 DO icgf = gto_basis_set%first_cgf(ishell, iset), &
1124 gto_basis_set%last_cgf(ishell, iset)
1125 gto_basis_set%norm_cgf(icgf) = 1.0_dp
1126 END DO
1127 END DO
1128 END DO
1129
1130 END SUBROUTINE init_norm_cgf_orb_den
1131
1132! **************************************************************************************************
1133!> \brief Initialise a Gaussian-type orbital (GTO) basis set data set.
1134!> \param gto_basis_set ...
1135!> \author MK
1136! **************************************************************************************************
1137 SUBROUTINE init_orb_basis_set(gto_basis_set)
1138
1139 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
1140
1141 CHARACTER(len=*), PARAMETER :: routinen = 'init_orb_basis_set'
1142
1143 INTEGER :: handle
1144
1145! -------------------------------------------------------------------------
1146
1147 IF (.NOT. ASSOCIATED(gto_basis_set)) RETURN
1148
1149 CALL timeset(routinen, handle)
1150
1151 SELECT CASE (gto_basis_set%norm_type)
1152 CASE (0)
1153 ! No normalisation requested
1154 CASE (1)
1155 CALL init_norm_cgf_orb_den(gto_basis_set)
1156 CASE (2)
1157 ! Normalise the primitive Gaussian functions
1158 CALL normalise_gcc_orb(gto_basis_set)
1159 ! Compute the normalization factors of the contracted Gaussian-type
1160 ! functions
1161 CALL init_norm_cgf_orb(gto_basis_set)
1162 CASE (3)
1163 CALL init_norm_cgf_orb(gto_basis_set)
1164 CASE DEFAULT
1165 cpabort("Normalization method not specified")
1166 END SELECT
1167
1168 ! Initialise the transformation matrices "pgf" -> "cgf"
1169
1170 CALL init_cphi_and_sphi(gto_basis_set, .true.)
1171
1172 CALL timestop(handle)
1173
1174 END SUBROUTINE init_orb_basis_set
1175
1176! **************************************************************************************************
1177!> \brief Normalise the primitive Cartesian Gaussian functions. The normalization
1178!> factor is included in the Gaussian contraction coefficients.
1179!> \param gto_basis_set ...
1180!> \author MK
1181! **************************************************************************************************
1182 SUBROUTINE normalise_gcc_orb(gto_basis_set)
1183
1184 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
1185
1186 INTEGER :: ipgf, iset, ishell, l
1187 REAL(kind=dp) :: expzet, gcca, prefac, zeta
1188
1189 DO iset = 1, gto_basis_set%nset
1190 DO ishell = 1, gto_basis_set%nshell(iset)
1191 l = gto_basis_set%l(ishell, iset)
1192 expzet = 0.25_dp*real(2*l + 3, dp)
1193 prefac = 2.0_dp**l*(2.0_dp/pi)**0.75_dp
1194 DO ipgf = 1, gto_basis_set%npgf(iset)
1195 gcca = gto_basis_set%gcc(ipgf, ishell, iset)
1196 zeta = gto_basis_set%zet(ipgf, iset)
1197 gto_basis_set%gcc(ipgf, ishell, iset) = prefac*zeta**expzet*gcca
1198 END DO
1199 END DO
1200 END DO
1201
1202 END SUBROUTINE normalise_gcc_orb
1203
1204! **************************************************************************************************
1205!> \brief Read a Gaussian-type orbital (GTO) basis set from the database file.
1206!> \param element_symbol ...
1207!> \param basis_set_name ...
1208!> \param gto_basis_set ...
1209!> \param para_env ...
1210!> \param dft_section ...
1211!> \author MK
1212! **************************************************************************************************
1213 SUBROUTINE read_gto_basis_set1(element_symbol, basis_set_name, gto_basis_set, &
1214 para_env, dft_section)
1215
1216 CHARACTER(LEN=*), INTENT(IN) :: element_symbol, basis_set_name
1217 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
1218 TYPE(mp_para_env_type), POINTER :: para_env
1219 TYPE(section_vals_type), POINTER :: dft_section
1220
1221 CHARACTER(LEN=240) :: line
1222 CHARACTER(LEN=242) :: line2
1223 CHARACTER(len=default_path_length) :: basis_set_file_name, tmp
1224 CHARACTER(LEN=default_path_length), DIMENSION(:), &
1225 POINTER :: cbasis
1226 CHARACTER(LEN=LEN(basis_set_name)) :: bsname
1227 CHARACTER(LEN=LEN(basis_set_name)+2) :: bsname2
1228 CHARACTER(LEN=LEN(element_symbol)) :: symbol
1229 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1230 INTEGER :: i, ibasis, ico, ipgf, irep, iset, ishell, lshell, m, maxco, maxl, maxpgf, &
1231 maxshell, nbasis, ncgf, nmin, nset, nsgf, sort_method, strlen1, strlen2
1232 INTEGER, DIMENSION(:), POINTER :: lmax, lmin, npgf, nshell
1233 INTEGER, DIMENSION(:, :), POINTER :: l, n
1234 LOGICAL :: basis_found, found, match
1235 REAL(KIND=dp), DIMENSION(:, :), POINTER :: zet
1236 REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: gcc
1237 TYPE(cp_parser_type) :: parser
1238
1239 line = ""
1240 line2 = ""
1241 symbol = ""
1242 symbol2 = ""
1243 bsname = ""
1244 bsname2 = ""
1245
1246 nbasis = 1
1247
1248 gto_basis_set%name = basis_set_name
1249 gto_basis_set%aliases = basis_set_name
1250 CALL section_vals_val_get(dft_section, "BASIS_SET_FILE_NAME", &
1251 n_rep_val=nbasis)
1252 ALLOCATE (cbasis(nbasis))
1253 DO ibasis = 1, nbasis
1254 CALL section_vals_val_get(dft_section, "BASIS_SET_FILE_NAME", &
1255 i_rep_val=ibasis, c_val=cbasis(ibasis))
1256 basis_set_file_name = cbasis(ibasis)
1257 tmp = basis_set_file_name
1258 CALL uppercase(tmp)
1259 IF (index(tmp, "MOLOPT") /= 0) CALL cite_reference(vandevondele2007)
1260 END DO
1261
1262 ! Search for the requested basis set in the basis set file
1263 ! until the basis set is found or the end of file is reached
1264
1265 basis_found = .false.
1266 basis_loop: DO ibasis = 1, nbasis
1267 IF (basis_found) EXIT basis_loop
1268 basis_set_file_name = cbasis(ibasis)
1269 CALL parser_create(parser, basis_set_file_name, para_env=para_env)
1270
1271 bsname = basis_set_name
1272 symbol = element_symbol
1273 irep = 0
1274
1275 tmp = basis_set_name
1276 CALL uppercase(tmp)
1277 IF (index(tmp, "MOLOPT") /= 0) CALL cite_reference(vandevondele2007)
1278
1279 nset = 0
1280 maxshell = 0
1281 maxpgf = 0
1282 maxco = 0
1283 ncgf = 0
1284 nsgf = 0
1285 gto_basis_set%nset = nset
1286 gto_basis_set%ncgf = ncgf
1287 gto_basis_set%nsgf = nsgf
1288 CALL reallocate(gto_basis_set%lmax, 1, nset)
1289 CALL reallocate(gto_basis_set%lmin, 1, nset)
1290 CALL reallocate(gto_basis_set%npgf, 1, nset)
1291 CALL reallocate(gto_basis_set%nshell, 1, nset)
1292 CALL reallocate(gto_basis_set%n, 1, maxshell, 1, nset)
1293 CALL reallocate(gto_basis_set%l, 1, maxshell, 1, nset)
1294 CALL reallocate(gto_basis_set%zet, 1, maxpgf, 1, nset)
1295 CALL reallocate(gto_basis_set%gcc, 1, maxpgf, 1, maxshell, 1, nset)
1296 CALL reallocate(gto_basis_set%set_radius, 1, nset)
1297 CALL reallocate(gto_basis_set%pgf_radius, 1, maxpgf, 1, nset)
1298 CALL reallocate(gto_basis_set%first_cgf, 1, maxshell, 1, nset)
1299 CALL reallocate(gto_basis_set%first_sgf, 1, maxshell, 1, nset)
1300 CALL reallocate(gto_basis_set%last_cgf, 1, maxshell, 1, nset)
1301 CALL reallocate(gto_basis_set%last_sgf, 1, maxshell, 1, nset)
1302 CALL reallocate(gto_basis_set%ncgf_set, 1, nset)
1303 CALL reallocate(gto_basis_set%nsgf_set, 1, nset)
1304 CALL reallocate(gto_basis_set%cphi, 1, maxco, 1, ncgf)
1305 CALL reallocate(gto_basis_set%sphi, 1, maxco, 1, nsgf)
1306 CALL reallocate(gto_basis_set%scon, 1, maxco, 1, nsgf)
1307 CALL reallocate(gto_basis_set%ccon, 1, maxco, 1, ncgf)
1308 CALL reallocate(gto_basis_set%lx, 1, ncgf)
1309 CALL reallocate(gto_basis_set%ly, 1, ncgf)
1310 CALL reallocate(gto_basis_set%lz, 1, ncgf)
1311 CALL reallocate(gto_basis_set%m, 1, nsgf)
1312 CALL reallocate(gto_basis_set%norm_cgf, 1, ncgf)
1313
1314 IF (tmp /= "NONE") THEN
1315 search_loop: DO
1316
1317 CALL parser_search_string(parser, trim(bsname), .true., found, line)
1318 IF (found) THEN
1319 CALL uppercase(symbol)
1320 CALL uppercase(bsname)
1321
1322 match = .false.
1323 CALL uppercase(line)
1324 ! Check both the element symbol and the basis set name
1325 line2 = " "//line//" "
1326 symbol2 = " "//trim(symbol)//" "
1327 bsname2 = " "//trim(bsname)//" "
1328 strlen1 = len_trim(symbol2) + 1
1329 strlen2 = len_trim(bsname2) + 1
1330
1331 IF ((index(line2, symbol2(:strlen1)) > 0) .AND. &
1332 (index(line2, bsname2(:strlen2)) > 0)) match = .true.
1333 IF (match) THEN
1334 ! copy all names into aliases field
1335 i = index(line2, symbol2(:strlen1))
1336 i = i + 1 + index(line2(i + 1:), " ")
1337 gto_basis_set%aliases = line2(i:)
1338
1339 NULLIFY (gcc, l, lmax, lmin, n, npgf, nshell, zet)
1340 ! Read the basis set information
1341 CALL parser_get_object(parser, nset, newline=.true.)
1342
1343 CALL reallocate(npgf, 1, nset)
1344 CALL reallocate(nshell, 1, nset)
1345 CALL reallocate(lmax, 1, nset)
1346 CALL reallocate(lmin, 1, nset)
1347 CALL reallocate(n, 1, 1, 1, nset)
1348
1349 maxl = 0
1350 maxpgf = 0
1351 maxshell = 0
1352
1353 DO iset = 1, nset
1354 CALL parser_get_object(parser, n(1, iset), newline=.true.)
1355 CALL parser_get_object(parser, lmin(iset))
1356 CALL parser_get_object(parser, lmax(iset))
1357 CALL parser_get_object(parser, npgf(iset))
1358 maxl = max(maxl, lmax(iset))
1359 IF (npgf(iset) > maxpgf) THEN
1360 maxpgf = npgf(iset)
1361 CALL reallocate(zet, 1, maxpgf, 1, nset)
1362 CALL reallocate(gcc, 1, maxpgf, 1, maxshell, 1, nset)
1363 END IF
1364 nshell(iset) = 0
1365 DO lshell = lmin(iset), lmax(iset)
1366 nmin = n(1, iset) + lshell - lmin(iset)
1367 CALL parser_get_object(parser, ishell)
1368 nshell(iset) = nshell(iset) + ishell
1369 IF (nshell(iset) > maxshell) THEN
1370 maxshell = nshell(iset)
1371 CALL reallocate(n, 1, maxshell, 1, nset)
1372 CALL reallocate(l, 1, maxshell, 1, nset)
1373 CALL reallocate(gcc, 1, maxpgf, 1, maxshell, 1, nset)
1374 END IF
1375 DO i = 1, ishell
1376 n(nshell(iset) - ishell + i, iset) = nmin + i - 1
1377 l(nshell(iset) - ishell + i, iset) = lshell
1378 END DO
1379 END DO
1380 DO ipgf = 1, npgf(iset)
1381 CALL parser_get_object(parser, zet(ipgf, iset), newline=.true.)
1382 DO ishell = 1, nshell(iset)
1383 CALL parser_get_object(parser, gcc(ipgf, ishell, iset))
1384 END DO
1385 END DO
1386 END DO
1387
1388 ! Maximum angular momentum quantum number of the atomic kind
1389
1390 CALL init_orbital_pointers(maxl)
1391
1392 ! Allocate the global variables
1393
1394 gto_basis_set%nset = nset
1395 CALL reallocate(gto_basis_set%lmax, 1, nset)
1396 CALL reallocate(gto_basis_set%lmin, 1, nset)
1397 CALL reallocate(gto_basis_set%npgf, 1, nset)
1398 CALL reallocate(gto_basis_set%nshell, 1, nset)
1399 CALL reallocate(gto_basis_set%n, 1, maxshell, 1, nset)
1400 CALL reallocate(gto_basis_set%l, 1, maxshell, 1, nset)
1401 CALL reallocate(gto_basis_set%zet, 1, maxpgf, 1, nset)
1402 CALL reallocate(gto_basis_set%gcc, 1, maxpgf, 1, maxshell, 1, nset)
1403
1404 ! Copy the basis set information into the data structure
1405
1406 DO iset = 1, nset
1407 gto_basis_set%lmax(iset) = lmax(iset)
1408 gto_basis_set%lmin(iset) = lmin(iset)
1409 gto_basis_set%npgf(iset) = npgf(iset)
1410 gto_basis_set%nshell(iset) = nshell(iset)
1411 DO ishell = 1, nshell(iset)
1412 gto_basis_set%n(ishell, iset) = n(ishell, iset)
1413 gto_basis_set%l(ishell, iset) = l(ishell, iset)
1414 DO ipgf = 1, npgf(iset)
1415 gto_basis_set%gcc(ipgf, ishell, iset) = gcc(ipgf, ishell, iset)
1416 END DO
1417 END DO
1418 DO ipgf = 1, npgf(iset)
1419 gto_basis_set%zet(ipgf, iset) = zet(ipgf, iset)
1420 END DO
1421 END DO
1422
1423 ! Initialise the depending atomic kind information
1424
1425 CALL reallocate(gto_basis_set%set_radius, 1, nset)
1426 CALL reallocate(gto_basis_set%pgf_radius, 1, maxpgf, 1, nset)
1427 CALL reallocate(gto_basis_set%first_cgf, 1, maxshell, 1, nset)
1428 CALL reallocate(gto_basis_set%first_sgf, 1, maxshell, 1, nset)
1429 CALL reallocate(gto_basis_set%last_cgf, 1, maxshell, 1, nset)
1430 CALL reallocate(gto_basis_set%last_sgf, 1, maxshell, 1, nset)
1431 CALL reallocate(gto_basis_set%ncgf_set, 1, nset)
1432 CALL reallocate(gto_basis_set%nsgf_set, 1, nset)
1433
1434 maxco = 0
1435 ncgf = 0
1436 nsgf = 0
1437
1438 DO iset = 1, nset
1439 gto_basis_set%ncgf_set(iset) = 0
1440 gto_basis_set%nsgf_set(iset) = 0
1441 DO ishell = 1, nshell(iset)
1442 lshell = gto_basis_set%l(ishell, iset)
1443 gto_basis_set%first_cgf(ishell, iset) = ncgf + 1
1444 ncgf = ncgf + nco(lshell)
1445 gto_basis_set%last_cgf(ishell, iset) = ncgf
1446 gto_basis_set%ncgf_set(iset) = &
1447 gto_basis_set%ncgf_set(iset) + nco(lshell)
1448 gto_basis_set%first_sgf(ishell, iset) = nsgf + 1
1449 nsgf = nsgf + nso(lshell)
1450 gto_basis_set%last_sgf(ishell, iset) = nsgf
1451 gto_basis_set%nsgf_set(iset) = &
1452 gto_basis_set%nsgf_set(iset) + nso(lshell)
1453 END DO
1454 maxco = max(maxco, npgf(iset)*ncoset(lmax(iset)))
1455 END DO
1456
1457 gto_basis_set%ncgf = ncgf
1458 gto_basis_set%nsgf = nsgf
1459
1460 CALL reallocate(gto_basis_set%cphi, 1, maxco, 1, ncgf)
1461 CALL reallocate(gto_basis_set%sphi, 1, maxco, 1, nsgf)
1462 CALL reallocate(gto_basis_set%scon, 1, maxco, 1, nsgf)
1463 CALL reallocate(gto_basis_set%ccon, 1, maxco, 1, ncgf)
1464 CALL reallocate(gto_basis_set%lx, 1, ncgf)
1465 CALL reallocate(gto_basis_set%ly, 1, ncgf)
1466 CALL reallocate(gto_basis_set%lz, 1, ncgf)
1467 CALL reallocate(gto_basis_set%m, 1, nsgf)
1468 CALL reallocate(gto_basis_set%norm_cgf, 1, ncgf)
1469 ALLOCATE (gto_basis_set%cgf_symbol(ncgf))
1470
1471 ALLOCATE (gto_basis_set%sgf_symbol(nsgf))
1472
1473 ncgf = 0
1474 nsgf = 0
1475
1476 DO iset = 1, nset
1477 DO ishell = 1, nshell(iset)
1478 lshell = gto_basis_set%l(ishell, iset)
1479 DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
1480 ncgf = ncgf + 1
1481 gto_basis_set%lx(ncgf) = indco(1, ico)
1482 gto_basis_set%ly(ncgf) = indco(2, ico)
1483 gto_basis_set%lz(ncgf) = indco(3, ico)
1484 gto_basis_set%cgf_symbol(ncgf) = &
1485 cgf_symbol(n(ishell, iset), [gto_basis_set%lx(ncgf), &
1486 gto_basis_set%ly(ncgf), &
1487 gto_basis_set%lz(ncgf)])
1488 END DO
1489 DO m = -lshell, lshell
1490 nsgf = nsgf + 1
1491 gto_basis_set%m(nsgf) = m
1492 gto_basis_set%sgf_symbol(nsgf) = &
1493 sgf_symbol(n(ishell, iset), lshell, m)
1494 END DO
1495 END DO
1496 END DO
1497
1498 DEALLOCATE (gcc, l, lmax, lmin, n, npgf, nshell, zet)
1499
1500 basis_found = .true.
1501 EXIT search_loop
1502 END IF
1503 ELSE
1504 EXIT search_loop
1505 END IF
1506 END DO search_loop
1507 ELSE
1508 match = .false.
1509 ALLOCATE (gto_basis_set%cgf_symbol(ncgf))
1510 ALLOCATE (gto_basis_set%sgf_symbol(nsgf))
1511 END IF
1512
1513 CALL parser_release(parser)
1514
1515 END DO basis_loop
1516
1517 IF (tmp /= "NONE") THEN
1518 IF (.NOT. basis_found) THEN
1519 basis_set_file_name = ""
1520 DO ibasis = 1, nbasis
1521 basis_set_file_name = trim(basis_set_file_name)//"<"//trim(cbasis(ibasis))//"> "
1522 END DO
1523 CALL cp_abort(__location__, &
1524 "The requested basis set <"//trim(bsname)// &
1525 "> for element <"//trim(symbol)//"> was not "// &
1526 "found in the basis set files "// &
1527 trim(basis_set_file_name))
1528 END IF
1529 END IF
1530 DEALLOCATE (cbasis)
1531
1532 CALL section_vals_val_get(dft_section, "SORT_BASIS", i_val=sort_method)
1533 CALL sort_gto_basis_set(gto_basis_set, sort_method)
1534
1535 END SUBROUTINE read_gto_basis_set1
1536
1537! **************************************************************************************************
1538!> \brief Read a Gaussian-type orbital (GTO) basis set from the database file.
1539!> \param element_symbol ...
1540!> \param basis_type ...
1541!> \param gto_basis_set ...
1542!> \param basis_section ...
1543!> \param irep ...
1544!> \param dft_section ...
1545!> \author MK
1546! **************************************************************************************************
1547 SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, &
1548 basis_section, irep, dft_section)
1549
1550 CHARACTER(LEN=*), INTENT(IN) :: element_symbol
1551 CHARACTER(LEN=*), INTENT(INOUT) :: basis_type
1552 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
1553 TYPE(section_vals_type), OPTIONAL, POINTER :: basis_section
1554 INTEGER :: irep
1555 TYPE(section_vals_type), OPTIONAL, POINTER :: dft_section
1556
1557 CHARACTER(len=20*default_string_length) :: line_att
1558 CHARACTER(LEN=240) :: line
1559 CHARACTER(LEN=242) :: line2
1560 CHARACTER(LEN=default_path_length) :: bsname, bsname2
1561 CHARACTER(LEN=LEN(element_symbol)) :: symbol
1562 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
1563 INTEGER :: i, ico, ipgf, iset, ishell, lshell, m, &
1564 maxco, maxl, maxpgf, maxshell, ncgf, &
1565 nmin, nset, nsgf, sort_method
1566 INTEGER, DIMENSION(:), POINTER :: lmax, lmin, npgf, nshell
1567 INTEGER, DIMENSION(:, :), POINTER :: l, n
1568 LOGICAL :: is_ok
1569 REAL(KIND=dp), DIMENSION(:, :), POINTER :: zet
1570 REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: gcc
1571 TYPE(cp_sll_val_type), POINTER :: list
1572 TYPE(val_type), POINTER :: val
1573
1574 line = ""
1575 line2 = ""
1576 symbol = ""
1577 symbol2 = ""
1578 bsname = ""
1579 bsname2 = ""
1580
1581 gto_basis_set%name = " "
1582 gto_basis_set%aliases = " "
1583
1584 bsname = " "
1585 symbol = element_symbol
1586
1587 nset = 0
1588 maxshell = 0
1589 maxpgf = 0
1590 maxco = 0
1591 ncgf = 0
1592 nsgf = 0
1593 gto_basis_set%nset = nset
1594 gto_basis_set%ncgf = ncgf
1595 gto_basis_set%nsgf = nsgf
1596 CALL reallocate(gto_basis_set%lmax, 1, nset)
1597 CALL reallocate(gto_basis_set%lmin, 1, nset)
1598 CALL reallocate(gto_basis_set%npgf, 1, nset)
1599 CALL reallocate(gto_basis_set%nshell, 1, nset)
1600 CALL reallocate(gto_basis_set%n, 1, maxshell, 1, nset)
1601 CALL reallocate(gto_basis_set%l, 1, maxshell, 1, nset)
1602 CALL reallocate(gto_basis_set%zet, 1, maxpgf, 1, nset)
1603 CALL reallocate(gto_basis_set%gcc, 1, maxpgf, 1, maxshell, 1, nset)
1604 CALL reallocate(gto_basis_set%set_radius, 1, nset)
1605 CALL reallocate(gto_basis_set%pgf_radius, 1, maxpgf, 1, nset)
1606 CALL reallocate(gto_basis_set%first_cgf, 1, maxshell, 1, nset)
1607 CALL reallocate(gto_basis_set%first_sgf, 1, maxshell, 1, nset)
1608 CALL reallocate(gto_basis_set%last_cgf, 1, maxshell, 1, nset)
1609 CALL reallocate(gto_basis_set%last_sgf, 1, maxshell, 1, nset)
1610 CALL reallocate(gto_basis_set%ncgf_set, 1, nset)
1611 CALL reallocate(gto_basis_set%nsgf_set, 1, nset)
1612 CALL reallocate(gto_basis_set%cphi, 1, maxco, 1, ncgf)
1613 CALL reallocate(gto_basis_set%sphi, 1, maxco, 1, nsgf)
1614 CALL reallocate(gto_basis_set%scon, 1, maxco, 1, nsgf)
1615 CALL reallocate(gto_basis_set%ccon, 1, maxco, 1, ncgf)
1616 CALL reallocate(gto_basis_set%lx, 1, ncgf)
1617 CALL reallocate(gto_basis_set%ly, 1, ncgf)
1618 CALL reallocate(gto_basis_set%lz, 1, ncgf)
1619 CALL reallocate(gto_basis_set%m, 1, nsgf)
1620 CALL reallocate(gto_basis_set%norm_cgf, 1, ncgf)
1621
1622 basis_type = ""
1623 CALL section_vals_val_get(basis_section, "_SECTION_PARAMETERS_", i_rep_section=irep, c_val=basis_type)
1624 IF (basis_type == "Orbital") basis_type = "ORB"
1625
1626 NULLIFY (list, val)
1627 CALL section_vals_list_get(basis_section, "_DEFAULT_KEYWORD_", i_rep_section=irep, list=list)
1628 CALL uppercase(symbol)
1629 CALL uppercase(bsname)
1630
1631 NULLIFY (gcc, l, lmax, lmin, n, npgf, nshell, zet)
1632 ! Read the basis set information
1633 is_ok = cp_sll_val_next(list, val)
1634 IF (.NOT. is_ok) cpabort("Error reading the Basis set from input file!")
1635 CALL val_get(val, c_val=line_att)
1636 READ (line_att, *) nset
1637
1638 CALL reallocate(npgf, 1, nset)
1639 CALL reallocate(nshell, 1, nset)
1640 CALL reallocate(lmax, 1, nset)
1641 CALL reallocate(lmin, 1, nset)
1642 CALL reallocate(n, 1, 1, 1, nset)
1643
1644 maxl = 0
1645 maxpgf = 0
1646 maxshell = 0
1647
1648 DO iset = 1, nset
1649 is_ok = cp_sll_val_next(list, val)
1650 IF (.NOT. is_ok) cpabort("Error reading the Basis set from input file!")
1651 CALL val_get(val, c_val=line_att)
1652 READ (line_att, *) n(1, iset)
1653 CALL remove_word(line_att)
1654 READ (line_att, *) lmin(iset)
1655 CALL remove_word(line_att)
1656 READ (line_att, *) lmax(iset)
1657 CALL remove_word(line_att)
1658 READ (line_att, *) npgf(iset)
1659 CALL remove_word(line_att)
1660 maxl = max(maxl, lmax(iset))
1661 IF (npgf(iset) > maxpgf) THEN
1662 maxpgf = npgf(iset)
1663 CALL reallocate(zet, 1, maxpgf, 1, nset)
1664 CALL reallocate(gcc, 1, maxpgf, 1, maxshell, 1, nset)
1665 END IF
1666 nshell(iset) = 0
1667 DO lshell = lmin(iset), lmax(iset)
1668 nmin = n(1, iset) + lshell - lmin(iset)
1669 READ (line_att, *) ishell
1670 CALL remove_word(line_att)
1671 nshell(iset) = nshell(iset) + ishell
1672 IF (nshell(iset) > maxshell) THEN
1673 maxshell = nshell(iset)
1674 CALL reallocate(n, 1, maxshell, 1, nset)
1675 CALL reallocate(l, 1, maxshell, 1, nset)
1676 CALL reallocate(gcc, 1, maxpgf, 1, maxshell, 1, nset)
1677 END IF
1678 DO i = 1, ishell
1679 n(nshell(iset) - ishell + i, iset) = nmin + i - 1
1680 l(nshell(iset) - ishell + i, iset) = lshell
1681 END DO
1682 END DO
1683 IF (len_trim(line_att) /= 0) THEN
1684 cpabort("Error reading the Basis from input file!")
1685 END IF
1686 DO ipgf = 1, npgf(iset)
1687 is_ok = cp_sll_val_next(list, val)
1688 IF (.NOT. is_ok) cpabort("Error reading the Basis set from input file!")
1689 CALL val_get(val, c_val=line_att)
1690 READ (line_att, *) zet(ipgf, iset), (gcc(ipgf, ishell, iset), ishell=1, nshell(iset))
1691 END DO
1692 END DO
1693
1694 ! Maximum angular momentum quantum number of the atomic kind
1695
1696 CALL init_orbital_pointers(maxl)
1697
1698 ! Allocate the global variables
1699
1700 gto_basis_set%nset = nset
1701 CALL reallocate(gto_basis_set%lmax, 1, nset)
1702 CALL reallocate(gto_basis_set%lmin, 1, nset)
1703 CALL reallocate(gto_basis_set%npgf, 1, nset)
1704 CALL reallocate(gto_basis_set%nshell, 1, nset)
1705 CALL reallocate(gto_basis_set%n, 1, maxshell, 1, nset)
1706 CALL reallocate(gto_basis_set%l, 1, maxshell, 1, nset)
1707 CALL reallocate(gto_basis_set%zet, 1, maxpgf, 1, nset)
1708 CALL reallocate(gto_basis_set%gcc, 1, maxpgf, 1, maxshell, 1, nset)
1709
1710 ! Copy the basis set information into the data structure
1711
1712 DO iset = 1, nset
1713 gto_basis_set%lmax(iset) = lmax(iset)
1714 gto_basis_set%lmin(iset) = lmin(iset)
1715 gto_basis_set%npgf(iset) = npgf(iset)
1716 gto_basis_set%nshell(iset) = nshell(iset)
1717 DO ishell = 1, nshell(iset)
1718 gto_basis_set%n(ishell, iset) = n(ishell, iset)
1719 gto_basis_set%l(ishell, iset) = l(ishell, iset)
1720 DO ipgf = 1, npgf(iset)
1721 gto_basis_set%gcc(ipgf, ishell, iset) = gcc(ipgf, ishell, iset)
1722 END DO
1723 END DO
1724 DO ipgf = 1, npgf(iset)
1725 gto_basis_set%zet(ipgf, iset) = zet(ipgf, iset)
1726 END DO
1727 END DO
1728
1729 ! Initialise the depending atomic kind information
1730
1731 CALL reallocate(gto_basis_set%set_radius, 1, nset)
1732 CALL reallocate(gto_basis_set%pgf_radius, 1, maxpgf, 1, nset)
1733 CALL reallocate(gto_basis_set%first_cgf, 1, maxshell, 1, nset)
1734 CALL reallocate(gto_basis_set%first_sgf, 1, maxshell, 1, nset)
1735 CALL reallocate(gto_basis_set%last_cgf, 1, maxshell, 1, nset)
1736 CALL reallocate(gto_basis_set%last_sgf, 1, maxshell, 1, nset)
1737 CALL reallocate(gto_basis_set%ncgf_set, 1, nset)
1738 CALL reallocate(gto_basis_set%nsgf_set, 1, nset)
1739
1740 maxco = 0
1741 ncgf = 0
1742 nsgf = 0
1743
1744 DO iset = 1, nset
1745 gto_basis_set%ncgf_set(iset) = 0
1746 gto_basis_set%nsgf_set(iset) = 0
1747 DO ishell = 1, nshell(iset)
1748 lshell = gto_basis_set%l(ishell, iset)
1749 gto_basis_set%first_cgf(ishell, iset) = ncgf + 1
1750 ncgf = ncgf + nco(lshell)
1751 gto_basis_set%last_cgf(ishell, iset) = ncgf
1752 gto_basis_set%ncgf_set(iset) = &
1753 gto_basis_set%ncgf_set(iset) + nco(lshell)
1754 gto_basis_set%first_sgf(ishell, iset) = nsgf + 1
1755 nsgf = nsgf + nso(lshell)
1756 gto_basis_set%last_sgf(ishell, iset) = nsgf
1757 gto_basis_set%nsgf_set(iset) = &
1758 gto_basis_set%nsgf_set(iset) + nso(lshell)
1759 END DO
1760 maxco = max(maxco, npgf(iset)*ncoset(lmax(iset)))
1761 END DO
1762
1763 gto_basis_set%ncgf = ncgf
1764 gto_basis_set%nsgf = nsgf
1765
1766 CALL reallocate(gto_basis_set%cphi, 1, maxco, 1, ncgf)
1767 CALL reallocate(gto_basis_set%sphi, 1, maxco, 1, nsgf)
1768 CALL reallocate(gto_basis_set%scon, 1, maxco, 1, nsgf)
1769 CALL reallocate(gto_basis_set%ccon, 1, maxco, 1, ncgf)
1770 CALL reallocate(gto_basis_set%lx, 1, ncgf)
1771 CALL reallocate(gto_basis_set%ly, 1, ncgf)
1772 CALL reallocate(gto_basis_set%lz, 1, ncgf)
1773 CALL reallocate(gto_basis_set%m, 1, nsgf)
1774 CALL reallocate(gto_basis_set%norm_cgf, 1, ncgf)
1775 ALLOCATE (gto_basis_set%cgf_symbol(ncgf))
1776
1777 ALLOCATE (gto_basis_set%sgf_symbol(nsgf))
1778
1779 ncgf = 0
1780 nsgf = 0
1781
1782 DO iset = 1, nset
1783 DO ishell = 1, nshell(iset)
1784 lshell = gto_basis_set%l(ishell, iset)
1785 DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
1786 ncgf = ncgf + 1
1787 gto_basis_set%lx(ncgf) = indco(1, ico)
1788 gto_basis_set%ly(ncgf) = indco(2, ico)
1789 gto_basis_set%lz(ncgf) = indco(3, ico)
1790 gto_basis_set%cgf_symbol(ncgf) = &
1791 cgf_symbol(n(ishell, iset), [gto_basis_set%lx(ncgf), &
1792 gto_basis_set%ly(ncgf), &
1793 gto_basis_set%lz(ncgf)])
1794 END DO
1795 DO m = -lshell, lshell
1796 nsgf = nsgf + 1
1797 gto_basis_set%m(nsgf) = m
1798 gto_basis_set%sgf_symbol(nsgf) = &
1799 sgf_symbol(n(ishell, iset), lshell, m)
1800 END DO
1801 END DO
1802 END DO
1803
1804 DEALLOCATE (gcc, l, lmax, lmin, n, npgf, nshell, zet)
1805
1806 IF (PRESENT(dft_section)) THEN
1807 CALL section_vals_val_get(dft_section, "SORT_BASIS", i_val=sort_method)
1808 CALL sort_gto_basis_set(gto_basis_set, sort_method)
1809 END IF
1810
1811 END SUBROUTINE read_gto_basis_set2
1812
1813! **************************************************************************************************
1814!> \brief Set the components of Gaussian-type orbital (GTO) basis set data set.
1815!> \param gto_basis_set ...
1816!> \param name ...
1817!> \param aliases ...
1818!> \param norm_type ...
1819!> \param kind_radius ...
1820!> \param ncgf ...
1821!> \param nset ...
1822!> \param nsgf ...
1823!> \param cgf_symbol ...
1824!> \param sgf_symbol ...
1825!> \param norm_cgf ...
1826!> \param set_radius ...
1827!> \param lmax ...
1828!> \param lmin ...
1829!> \param lx ...
1830!> \param ly ...
1831!> \param lz ...
1832!> \param m ...
1833!> \param ncgf_set ...
1834!> \param npgf ...
1835!> \param nsgf_set ...
1836!> \param nshell ...
1837!> \param cphi ...
1838!> \param pgf_radius ...
1839!> \param sphi ...
1840!> \param scon ...
1841!> \param zet ...
1842!> \param first_cgf ...
1843!> \param first_sgf ...
1844!> \param l ...
1845!> \param last_cgf ...
1846!> \param last_sgf ...
1847!> \param n ...
1848!> \param gcc ...
1849!> \param short_kind_radius ...
1850!> \param ccon ...
1851!> \author MK
1852! **************************************************************************************************
1853 SUBROUTINE set_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, &
1854 nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, &
1855 lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, &
1856 cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, &
1857 last_cgf, last_sgf, n, gcc, short_kind_radius, ccon)
1858
1859 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
1860 CHARACTER(LEN=default_string_length), INTENT(IN), &
1861 OPTIONAL :: name, aliases
1862 INTEGER, INTENT(IN), OPTIONAL :: norm_type
1863 REAL(kind=dp), INTENT(IN), OPTIONAL :: kind_radius
1864 INTEGER, INTENT(IN), OPTIONAL :: ncgf, nset, nsgf
1865 CHARACTER(LEN=12), DIMENSION(:), OPTIONAL, POINTER :: cgf_symbol
1866 CHARACTER(LEN=6), DIMENSION(:), OPTIONAL, POINTER :: sgf_symbol
1867 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: norm_cgf, set_radius
1868 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: lmax, lmin, lx, ly, lz, m, ncgf_set, &
1869 npgf, nsgf_set, nshell
1870 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cphi, pgf_radius, sphi, scon, zet
1871 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: first_cgf, first_sgf, l, last_cgf, &
1872 last_sgf, n
1873 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
1874 POINTER :: gcc
1875 REAL(kind=dp), INTENT(IN), OPTIONAL :: short_kind_radius
1876 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: ccon
1877
1878 IF (PRESENT(name)) gto_basis_set%name = name
1879 IF (PRESENT(aliases)) gto_basis_set%aliases = aliases
1880 IF (PRESENT(norm_type)) gto_basis_set%norm_type = norm_type
1881 IF (PRESENT(kind_radius)) gto_basis_set%kind_radius = kind_radius
1882 IF (PRESENT(short_kind_radius)) gto_basis_set%short_kind_radius = short_kind_radius
1883 IF (PRESENT(ncgf)) gto_basis_set%ncgf = ncgf
1884 IF (PRESENT(nset)) gto_basis_set%nset = nset
1885 IF (PRESENT(nsgf)) gto_basis_set%nsgf = nsgf
1886 IF (PRESENT(cgf_symbol)) gto_basis_set%cgf_symbol(:) = cgf_symbol(:)
1887 IF (PRESENT(sgf_symbol)) gto_basis_set%sgf_symbol(:) = sgf_symbol(:)
1888 IF (PRESENT(norm_cgf)) gto_basis_set%norm_cgf(:) = norm_cgf(:)
1889 IF (PRESENT(set_radius)) gto_basis_set%set_radius(:) = set_radius(:)
1890 IF (PRESENT(lmax)) gto_basis_set%lmax(:) = lmax(:)
1891 IF (PRESENT(lmin)) gto_basis_set%lmin(:) = lmin(:)
1892 IF (PRESENT(lx)) gto_basis_set%lx(:) = lx(:)
1893 IF (PRESENT(ly)) gto_basis_set%ly(:) = ly(:)
1894 IF (PRESENT(lz)) gto_basis_set%lz(:) = lz(:)
1895 IF (PRESENT(m)) gto_basis_set%m(:) = m(:)
1896 IF (PRESENT(ncgf_set)) gto_basis_set%ncgf_set(:) = ncgf_set(:)
1897 IF (PRESENT(npgf)) gto_basis_set%npgf(:) = npgf(:)
1898 IF (PRESENT(nsgf_set)) gto_basis_set%nsgf_set(:) = nsgf_set(:)
1899 IF (PRESENT(nshell)) gto_basis_set%nshell(:) = nshell(:)
1900 IF (PRESENT(cphi)) gto_basis_set%cphi(:, :) = cphi(:, :)
1901 IF (PRESENT(pgf_radius)) gto_basis_set%pgf_radius(:, :) = pgf_radius(:, :)
1902 IF (PRESENT(sphi)) gto_basis_set%sphi(:, :) = sphi(:, :)
1903 IF (PRESENT(scon)) gto_basis_set%scon(:, :) = scon(:, :)
1904 IF (PRESENT(ccon)) gto_basis_set%ccon(:, :) = ccon(:, :)
1905 IF (PRESENT(zet)) gto_basis_set%zet(:, :) = zet(:, :)
1906 IF (PRESENT(first_cgf)) gto_basis_set%first_cgf(:, :) = first_cgf(:, :)
1907 IF (PRESENT(first_sgf)) gto_basis_set%first_sgf(:, :) = first_sgf(:, :)
1908 IF (PRESENT(l)) l(:, :) = gto_basis_set%l(:, :)
1909 IF (PRESENT(last_cgf)) gto_basis_set%last_cgf(:, :) = last_cgf(:, :)
1910 IF (PRESENT(last_sgf)) gto_basis_set%last_sgf(:, :) = last_sgf(:, :)
1911 IF (PRESENT(n)) gto_basis_set%n(:, :) = n(:, :)
1912 IF (PRESENT(gcc)) gto_basis_set%gcc(:, :, :) = gcc(:, :, :)
1913
1914 END SUBROUTINE set_gto_basis_set
1915
1916! **************************************************************************************************
1917!> \brief Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
1918!> \param gto_basis_set ...
1919!> \param output_unit ...
1920!> \param header ...
1921!> \author MK
1922! **************************************************************************************************
1923 SUBROUTINE write_gto_basis_set(gto_basis_set, output_unit, header)
1924
1925 TYPE(gto_basis_set_type), INTENT(IN) :: gto_basis_set
1926 INTEGER, INTENT(in) :: output_unit
1927 CHARACTER(len=*), OPTIONAL :: header
1928
1929 INTEGER :: ipgf, iset, ishell
1930
1931 IF (output_unit > 0) THEN
1932
1933 IF (PRESENT(header)) THEN
1934 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40)") &
1935 trim(header), trim(gto_basis_set%name)
1936 END IF
1937
1938 WRITE (unit=output_unit, fmt="(/,(T8,A,T71,I10))") &
1939 "Number of orbital shell sets: ", &
1940 gto_basis_set%nset, &
1941 "Number of orbital shells: ", &
1942 sum(gto_basis_set%nshell(:)), &
1943 "Number of primitive Cartesian functions: ", &
1944 sum(gto_basis_set%npgf(:)), &
1945 "Number of Cartesian basis functions: ", &
1946 gto_basis_set%ncgf, &
1947 "Number of spherical basis functions: ", &
1948 gto_basis_set%nsgf, &
1949 "Norm type: ", &
1950 gto_basis_set%norm_type
1951
1952 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40,/,/,T25,A)") &
1953 "GTO basis set information for", trim(gto_basis_set%name), &
1954 "Set Shell n l Exponent Coefficient"
1955
1956 DO iset = 1, gto_basis_set%nset
1957 WRITE (unit=output_unit, fmt="(A)") ""
1958 DO ishell = 1, gto_basis_set%nshell(iset)
1959 WRITE (unit=output_unit, &
1960 fmt="(T25,I3,4X,I4,4X,I2,2X,I2,(T51,2F15.6))") &
1961 iset, ishell, &
1962 gto_basis_set%n(ishell, iset), &
1963 gto_basis_set%l(ishell, iset), &
1964 (gto_basis_set%zet(ipgf, iset), &
1965 gto_basis_set%gcc(ipgf, ishell, iset), &
1966 ipgf=1, gto_basis_set%npgf(iset))
1967 END DO
1968 END DO
1969
1970 END IF
1971
1972 END SUBROUTINE write_gto_basis_set
1973
1974! **************************************************************************************************
1975
1976! **************************************************************************************************
1977!> \brief Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
1978!> \param orb_basis_set ...
1979!> \param output_unit ...
1980!> \param header ...
1981!> \author MK
1982! **************************************************************************************************
1983 SUBROUTINE write_orb_basis_set(orb_basis_set, output_unit, header)
1984
1985 TYPE(gto_basis_set_type), INTENT(IN) :: orb_basis_set
1986 INTEGER, INTENT(in) :: output_unit
1987 CHARACTER(len=*), OPTIONAL :: header
1988
1989 INTEGER :: icgf, ico, ipgf, iset, ishell
1990
1991 IF (output_unit > 0) THEN
1992 IF (PRESENT(header)) THEN
1993 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40)") &
1994 trim(header), trim(orb_basis_set%name)
1995 END IF
1996
1997 WRITE (unit=output_unit, fmt="(/,(T8,A,T71,I10))") &
1998 "Number of orbital shell sets: ", &
1999 orb_basis_set%nset, &
2000 "Number of orbital shells: ", &
2001 sum(orb_basis_set%nshell(:)), &
2002 "Number of primitive Cartesian functions: ", &
2003 sum(orb_basis_set%npgf(:)), &
2004 "Number of Cartesian basis functions: ", &
2005 orb_basis_set%ncgf, &
2006 "Number of spherical basis functions: ", &
2007 orb_basis_set%nsgf, &
2008 "Norm type: ", &
2009 orb_basis_set%norm_type
2010
2011 WRITE (unit=output_unit, fmt="(/,T8,A,/,/,T25,A)") &
2012 "Normalised Cartesian orbitals:", &
2013 "Set Shell Orbital Exponent Coefficient"
2014
2015 icgf = 0
2016
2017 DO iset = 1, orb_basis_set%nset
2018 DO ishell = 1, orb_basis_set%nshell(iset)
2019 WRITE (unit=output_unit, fmt="(A)") ""
2020 DO ico = 1, nco(orb_basis_set%l(ishell, iset))
2021 icgf = icgf + 1
2022 WRITE (unit=output_unit, &
2023 fmt="(T25,I3,4X,I4,3X,A12,(T51,2F15.6))") &
2024 iset, ishell, orb_basis_set%cgf_symbol(icgf), &
2025 (orb_basis_set%zet(ipgf, iset), &
2026 orb_basis_set%norm_cgf(icgf)* &
2027 orb_basis_set%gcc(ipgf, ishell, iset), &
2028 ipgf=1, orb_basis_set%npgf(iset))
2029 END DO
2030 END DO
2031 END DO
2032 END IF
2033
2034 END SUBROUTINE write_orb_basis_set
2035
2036! **************************************************************************************************
2037!> \brief ...
2038!> \param gto_basis_set ...
2039!> \param output_unit ...
2040!> \author JGH
2041! **************************************************************************************************
2042 SUBROUTINE dump_gto_basis_set(gto_basis_set, output_unit)
2043
2044 TYPE(gto_basis_set_type), INTENT(IN) :: gto_basis_set
2045 INTEGER, INTENT(in) :: output_unit
2046
2047 INTEGER :: ipgf, iset, ishell
2048
2049 IF (output_unit > 0) THEN
2050
2051 WRITE (unit=output_unit, fmt="(/,T6,A40)") trim(gto_basis_set%name)
2052 WRITE (unit=output_unit, fmt="(/,T6,A40)") trim(gto_basis_set%aliases)
2053 WRITE (unit=output_unit, fmt="(/,T6,F12.8)") gto_basis_set%kind_radius
2054 WRITE (unit=output_unit, fmt="(/,T6,F12.8)") gto_basis_set%short_kind_radius
2055 WRITE (unit=output_unit, fmt="(/,T6,I8)") gto_basis_set%norm_type
2056 WRITE (unit=output_unit, fmt="(/,T6,3I8)") gto_basis_set%ncgf, gto_basis_set%nset, gto_basis_set%nsgf
2057 WRITE (unit=output_unit, fmt="(/,T6,6A12)") gto_basis_set%cgf_symbol
2058 WRITE (unit=output_unit, fmt="(/,T6,6A12)") gto_basis_set%sgf_symbol
2059 WRITE (unit=output_unit, fmt="(/,T6,6F12.6)") gto_basis_set%norm_cgf
2060 WRITE (unit=output_unit, fmt="(/,T6,6F12.6)") gto_basis_set%set_radius
2061 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lmax
2062 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lmin
2063 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lx
2064 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%ly
2065 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lz
2066 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%m
2067 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%ncgf_set
2068 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%nsgf_set
2069 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%npgf
2070 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%nshell
2071
2072 DO iset = 1, gto_basis_set%nset
2073 WRITE (unit=output_unit, fmt="(T8,6F15.6)") &
2074 gto_basis_set%pgf_radius(1:gto_basis_set%npgf(iset), iset)
2075 END DO
2076
2077 DO iset = 1, gto_basis_set%nset
2078 WRITE (unit=output_unit, fmt="(T8,6F15.6)") &
2079 gto_basis_set%zet(1:gto_basis_set%npgf(iset), iset)
2080 END DO
2081
2082 DO iset = 1, gto_basis_set%nset
2083 DO ishell = 1, gto_basis_set%nshell(iset)
2084 WRITE (unit=output_unit, fmt="(T8,8I10)") &
2085 iset, ishell, &
2086 gto_basis_set%n(ishell, iset), &
2087 gto_basis_set%l(ishell, iset), &
2088 gto_basis_set%first_cgf(ishell, iset), &
2089 gto_basis_set%last_cgf(ishell, iset), &
2090 gto_basis_set%first_sgf(ishell, iset), &
2091 gto_basis_set%last_sgf(ishell, iset)
2092 END DO
2093 END DO
2094
2095 DO iset = 1, gto_basis_set%nset
2096 DO ishell = 1, gto_basis_set%nshell(iset)
2097 WRITE (unit=output_unit, fmt="(T8,2I5,(T25,4F15.6))") &
2098 iset, ishell, &
2099 (gto_basis_set%gcc(ipgf, ishell, iset), &
2100 ipgf=1, gto_basis_set%npgf(iset))
2101 END DO
2102 END DO
2103
2104 WRITE (unit=output_unit, fmt="(A5)") "CPHI"
2105 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%cphi
2106 WRITE (unit=output_unit, fmt="(A1)") "SPHI"
2107 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%sphi
2108 WRITE (unit=output_unit, fmt="(A1)") "SCON"
2109 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%scon
2110 WRITE (unit=output_unit, fmt="(A1)") "CCON"
2111 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%ccon
2112
2113 END IF
2114
2115 END SUBROUTINE dump_gto_basis_set
2116
2117! **************************************************************************************************
2118!> \brief ...
2119!> \param sto_basis_set ...
2120! **************************************************************************************************
2121 SUBROUTINE allocate_sto_basis_set(sto_basis_set)
2122
2123 TYPE(sto_basis_set_type), POINTER :: sto_basis_set
2124
2125 CALL deallocate_sto_basis_set(sto_basis_set)
2126
2127 ALLOCATE (sto_basis_set)
2128
2129 END SUBROUTINE allocate_sto_basis_set
2130
2131! **************************************************************************************************
2132!> \brief ...
2133!> \param sto_basis_set ...
2134! **************************************************************************************************
2135 SUBROUTINE deallocate_sto_basis_set(sto_basis_set)
2136
2137 TYPE(sto_basis_set_type), POINTER :: sto_basis_set
2138
2139! -------------------------------------------------------------------------
2140
2141 IF (ASSOCIATED(sto_basis_set)) THEN
2142 IF (ASSOCIATED(sto_basis_set%symbol)) THEN
2143 DEALLOCATE (sto_basis_set%symbol)
2144 END IF
2145 IF (ASSOCIATED(sto_basis_set%nq)) THEN
2146 DEALLOCATE (sto_basis_set%nq)
2147 END IF
2148 IF (ASSOCIATED(sto_basis_set%lq)) THEN
2149 DEALLOCATE (sto_basis_set%lq)
2150 END IF
2151 IF (ASSOCIATED(sto_basis_set%zet)) THEN
2152 DEALLOCATE (sto_basis_set%zet)
2153 END IF
2154
2155 DEALLOCATE (sto_basis_set)
2156 END IF
2157 END SUBROUTINE deallocate_sto_basis_set
2158
2159! **************************************************************************************************
2160!> \brief ...
2161!> \param sto_basis_set ...
2162!> \param name ...
2163!> \param nshell ...
2164!> \param symbol ...
2165!> \param nq ...
2166!> \param lq ...
2167!> \param zet ...
2168!> \param maxlq ...
2169!> \param numsto ...
2170! **************************************************************************************************
2171 SUBROUTINE get_sto_basis_set(sto_basis_set, name, nshell, symbol, nq, lq, zet, maxlq, numsto)
2172
2173 TYPE(sto_basis_set_type), INTENT(IN) :: sto_basis_set
2174 CHARACTER(LEN=default_string_length), &
2175 INTENT(OUT), OPTIONAL :: name
2176 INTEGER, INTENT(OUT), OPTIONAL :: nshell
2177 CHARACTER(LEN=6), DIMENSION(:), OPTIONAL, POINTER :: symbol
2178 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nq, lq
2179 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: zet
2180 INTEGER, INTENT(OUT), OPTIONAL :: maxlq, numsto
2181
2182 INTEGER :: iset
2183
2184 IF (PRESENT(name)) name = sto_basis_set%name
2185 IF (PRESENT(nshell)) nshell = sto_basis_set%nshell
2186 IF (PRESENT(symbol)) symbol => sto_basis_set%symbol
2187 IF (PRESENT(nq)) nq => sto_basis_set%nq
2188 IF (PRESENT(lq)) lq => sto_basis_set%lq
2189 IF (PRESENT(zet)) zet => sto_basis_set%zet
2190 IF (PRESENT(maxlq)) THEN
2191 maxlq = maxval(sto_basis_set%lq(1:sto_basis_set%nshell))
2192 END IF
2193 IF (PRESENT(numsto)) THEN
2194 numsto = 0
2195 DO iset = 1, sto_basis_set%nshell
2196 numsto = numsto + 2*sto_basis_set%lq(iset) + 1
2197 END DO
2198 END IF
2199
2200 END SUBROUTINE get_sto_basis_set
2201
2202! **************************************************************************************************
2203!> \brief ...
2204!> \param sto_basis_set ...
2205!> \param name ...
2206!> \param nshell ...
2207!> \param symbol ...
2208!> \param nq ...
2209!> \param lq ...
2210!> \param zet ...
2211! **************************************************************************************************
2212 SUBROUTINE set_sto_basis_set(sto_basis_set, name, nshell, symbol, nq, lq, zet)
2213
2214 TYPE(sto_basis_set_type), INTENT(INOUT) :: sto_basis_set
2215 CHARACTER(LEN=default_string_length), INTENT(IN), &
2216 OPTIONAL :: name
2217 INTEGER, INTENT(IN), OPTIONAL :: nshell
2218 CHARACTER(LEN=6), DIMENSION(:), OPTIONAL, POINTER :: symbol
2219 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nq, lq
2220 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: zet
2221
2222 INTEGER :: ns
2223
2224 IF (PRESENT(name)) sto_basis_set%name = name
2225 IF (PRESENT(nshell)) sto_basis_set%nshell = nshell
2226 IF (PRESENT(symbol)) THEN
2227 ns = SIZE(symbol)
2228 IF (ASSOCIATED(sto_basis_set%symbol)) DEALLOCATE (sto_basis_set%symbol)
2229 ALLOCATE (sto_basis_set%symbol(1:ns))
2230 sto_basis_set%symbol(:) = symbol(:)
2231 END IF
2232 IF (PRESENT(nq)) THEN
2233 ns = SIZE(nq)
2234 CALL reallocate(sto_basis_set%nq, 1, ns)
2235 sto_basis_set%nq = nq(:)
2236 END IF
2237 IF (PRESENT(lq)) THEN
2238 ns = SIZE(lq)
2239 CALL reallocate(sto_basis_set%lq, 1, ns)
2240 sto_basis_set%lq = lq(:)
2241 END IF
2242 IF (PRESENT(zet)) THEN
2243 ns = SIZE(zet)
2244 CALL reallocate(sto_basis_set%zet, 1, ns)
2245 sto_basis_set%zet = zet(:)
2246 END IF
2247
2248 END SUBROUTINE set_sto_basis_set
2249
2250! **************************************************************************************************
2251!> \brief ...
2252!> \param element_symbol ...
2253!> \param basis_set_name ...
2254!> \param sto_basis_set ...
2255!> \param para_env ...
2256!> \param dft_section ...
2257! **************************************************************************************************
2258 SUBROUTINE read_sto_basis_set(element_symbol, basis_set_name, sto_basis_set, para_env, dft_section)
2259
2260 ! Read a Slater-type orbital (STO) basis set from the database file.
2261
2262 CHARACTER(LEN=*), INTENT(IN) :: element_symbol, basis_set_name
2263 TYPE(sto_basis_set_type), INTENT(INOUT) :: sto_basis_set
2264 TYPE(mp_para_env_type), POINTER :: para_env
2265 TYPE(section_vals_type), POINTER :: dft_section
2266
2267 CHARACTER(LEN=10) :: nlsym
2268 CHARACTER(LEN=2) :: lsym
2269 CHARACTER(LEN=240) :: line
2270 CHARACTER(LEN=242) :: line2
2271 CHARACTER(len=default_path_length) :: basis_set_file_name, tmp
2272 CHARACTER(LEN=default_path_length), DIMENSION(:), &
2273 POINTER :: cbasis
2274 CHARACTER(LEN=LEN(basis_set_name)) :: bsname
2275 CHARACTER(LEN=LEN(basis_set_name)+2) :: bsname2
2276 CHARACTER(LEN=LEN(element_symbol)) :: symbol
2277 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
2278 INTEGER :: ibasis, irep, iset, nbasis, nq, nset, &
2279 strlen1, strlen2
2280 LOGICAL :: basis_found, found, match
2281 REAL(kind=dp) :: zet
2282 TYPE(cp_parser_type) :: parser
2283
2284 line = ""
2285 line2 = ""
2286 symbol = ""
2287 symbol2 = ""
2288 bsname = ""
2289 bsname2 = ""
2290
2291 nbasis = 1
2292
2293 sto_basis_set%name = basis_set_name
2294 CALL section_vals_val_get(dft_section, "BASIS_SET_FILE_NAME", &
2295 n_rep_val=nbasis)
2296 ALLOCATE (cbasis(nbasis))
2297 DO ibasis = 1, nbasis
2298 CALL section_vals_val_get(dft_section, "BASIS_SET_FILE_NAME", &
2299 i_rep_val=ibasis, c_val=cbasis(ibasis))
2300 basis_set_file_name = cbasis(ibasis)
2301 tmp = basis_set_file_name
2302 CALL uppercase(tmp)
2303 END DO
2304
2305 ! Search for the requested basis set in the basis set file
2306 ! until the basis set is found or the end of file is reached
2307
2308 basis_found = .false.
2309 basis_loop: DO ibasis = 1, nbasis
2310 IF (basis_found) EXIT basis_loop
2311 basis_set_file_name = cbasis(ibasis)
2312 CALL parser_create(parser, basis_set_file_name, para_env=para_env)
2313
2314 bsname = basis_set_name
2315 symbol = element_symbol
2316 irep = 0
2317
2318 tmp = basis_set_name
2319 CALL uppercase(tmp)
2320
2321 IF (tmp /= "NONE") THEN
2322 search_loop: DO
2323
2324 CALL parser_search_string(parser, trim(bsname), .true., found, line)
2325 IF (found) THEN
2326 CALL uppercase(symbol)
2327 CALL uppercase(bsname)
2328
2329 match = .false.
2330 CALL uppercase(line)
2331 ! Check both the element symbol and the basis set name
2332 line2 = " "//line//" "
2333 symbol2 = " "//trim(symbol)//" "
2334 bsname2 = " "//trim(bsname)//" "
2335 strlen1 = len_trim(symbol2) + 1
2336 strlen2 = len_trim(bsname2) + 1
2337
2338 IF ((index(line2, symbol2(:strlen1)) > 0) .AND. &
2339 (index(line2, bsname2(:strlen2)) > 0)) match = .true.
2340 IF (match) THEN
2341 ! Read the basis set information
2342 CALL parser_get_object(parser, nset, newline=.true.)
2343 sto_basis_set%nshell = nset
2344
2345 CALL reallocate(sto_basis_set%nq, 1, nset)
2346 CALL reallocate(sto_basis_set%lq, 1, nset)
2347 CALL reallocate(sto_basis_set%zet, 1, nset)
2348 ALLOCATE (sto_basis_set%symbol(nset))
2349
2350 DO iset = 1, nset
2351 CALL parser_get_object(parser, nq, newline=.true.)
2352 CALL parser_get_object(parser, lsym)
2353 CALL parser_get_object(parser, zet)
2354 sto_basis_set%nq(iset) = nq
2355 sto_basis_set%zet(iset) = zet
2356 WRITE (nlsym, "(I2,A)") nq, trim(lsym)
2357 sto_basis_set%symbol(iset) = trim(nlsym)
2358 SELECT CASE (trim(lsym))
2359 CASE ("S", "s")
2360 sto_basis_set%lq(iset) = 0
2361 CASE ("P", "p")
2362 sto_basis_set%lq(iset) = 1
2363 CASE ("D", "d")
2364 sto_basis_set%lq(iset) = 2
2365 CASE ("F", "f")
2366 sto_basis_set%lq(iset) = 3
2367 CASE ("G", "g")
2368 sto_basis_set%lq(iset) = 4
2369 CASE ("H", "h")
2370 sto_basis_set%lq(iset) = 5
2371 CASE ("I", "i", "J", "j")
2372 sto_basis_set%lq(iset) = 6
2373 CASE ("K", "k")
2374 sto_basis_set%lq(iset) = 7
2375 CASE ("L", "l")
2376 sto_basis_set%lq(iset) = 8
2377 CASE ("M", "m")
2378 sto_basis_set%lq(iset) = 9
2379 CASE DEFAULT
2380 CALL cp_abort(__location__, &
2381 "The requested basis set <"//trim(bsname)// &
2382 "> for element <"//trim(symbol)//"> has an invalid component: ")
2383 END SELECT
2384 END DO
2385
2386 basis_found = .true.
2387 EXIT search_loop
2388 END IF
2389 ELSE
2390 EXIT search_loop
2391 END IF
2392 END DO search_loop
2393 ELSE
2394 match = .false.
2395 END IF
2396
2397 CALL parser_release(parser)
2398
2399 END DO basis_loop
2400
2401 IF (tmp /= "NONE") THEN
2402 IF (.NOT. basis_found) THEN
2403 basis_set_file_name = ""
2404 DO ibasis = 1, nbasis
2405 basis_set_file_name = trim(basis_set_file_name)//"<"//trim(cbasis(ibasis))//"> "
2406 END DO
2407 CALL cp_abort(__location__, &
2408 "The requested basis set <"//trim(bsname)// &
2409 "> for element <"//trim(symbol)//"> was not "// &
2410 "found in the basis set files "// &
2411 trim(basis_set_file_name))
2412 END IF
2413 END IF
2414 DEALLOCATE (cbasis)
2415
2416 END SUBROUTINE read_sto_basis_set
2417
2418! **************************************************************************************************
2419!> \brief ...
2420!> \param sto_basis_set ...
2421!> \param gto_basis_set ...
2422!> \param ngauss ...
2423!> \param ortho ...
2424! **************************************************************************************************
2425 SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho)
2426
2427 TYPE(sto_basis_set_type), INTENT(IN) :: sto_basis_set
2428 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
2429 INTEGER, INTENT(IN), OPTIONAL :: ngauss
2430 LOGICAL, INTENT(IN), OPTIONAL :: ortho
2431
2432 INTEGER, PARAMETER :: maxng = 6
2433
2434 CHARACTER(LEN=default_string_length) :: name, sng
2435 INTEGER :: ipgf, iset, maxl, ng, nset, nshell
2436 INTEGER, DIMENSION(:), POINTER :: lq, nq
2437 LOGICAL :: do_ortho
2438 REAL(kind=dp), DIMENSION(:), POINTER :: zet
2439 REAL(kind=dp), DIMENSION(maxng) :: gcc, zetg
2440
2441 ng = 6
2442 IF (PRESENT(ngauss)) ng = ngauss
2443 IF (ng > maxng) cpabort("Too many Gaussian primitives requested")
2444 do_ortho = .false.
2445 IF (PRESENT(ortho)) do_ortho = ortho
2446
2447 CALL allocate_gto_basis_set(gto_basis_set)
2448
2449 CALL get_sto_basis_set(sto_basis_set, name=name, nshell=nshell, nq=nq, &
2450 lq=lq, zet=zet)
2451
2452 maxl = maxval(lq)
2453 CALL init_orbital_pointers(maxl)
2454
2455 CALL integer_to_string(ng, sng)
2456 gto_basis_set%name = trim(name)//"_STO-"//trim(sng)//"G"
2457
2458 nset = nshell
2459 gto_basis_set%nset = nset
2460 CALL reallocate(gto_basis_set%lmax, 1, nset)
2461 CALL reallocate(gto_basis_set%lmin, 1, nset)
2462 CALL reallocate(gto_basis_set%npgf, 1, nset)
2463 CALL reallocate(gto_basis_set%nshell, 1, nset)
2464 CALL reallocate(gto_basis_set%n, 1, 1, 1, nset)
2465 CALL reallocate(gto_basis_set%l, 1, 1, 1, nset)
2466 CALL reallocate(gto_basis_set%zet, 1, ng, 1, nset)
2467 CALL reallocate(gto_basis_set%gcc, 1, ng, 1, 1, 1, nset)
2468
2469 DO iset = 1, nset
2470 CALL get_sto_ng(zet(iset), ng, nq(iset), lq(iset), zetg, gcc)
2471 gto_basis_set%lmax(iset) = lq(iset)
2472 gto_basis_set%lmin(iset) = lq(iset)
2473 gto_basis_set%npgf(iset) = ng
2474 gto_basis_set%nshell(iset) = 1
2475 gto_basis_set%n(1, iset) = lq(iset) + 1
2476 gto_basis_set%l(1, iset) = lq(iset)
2477 DO ipgf = 1, ng
2478 gto_basis_set%gcc(ipgf, 1, iset) = gcc(ipgf)
2479 gto_basis_set%zet(ipgf, iset) = zetg(ipgf)
2480 END DO
2481 END DO
2482
2483 CALL process_gto_basis(gto_basis_set, do_ortho, nset, maxl)
2484
2485 END SUBROUTINE create_gto_from_sto_basis
2486
2487! **************************************************************************************************
2488!> \brief ...
2489!> \param gto_basis_set ...
2490!> \param do_ortho ...
2491!> \param nset ...
2492!> \param maxl ...
2493! **************************************************************************************************
2494 SUBROUTINE process_gto_basis(gto_basis_set, do_ortho, nset, maxl)
2495
2496 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
2497 LOGICAL, INTENT(IN), OPTIONAL :: do_ortho
2498 INTEGER, INTENT(IN) :: nset, maxl
2499
2500 INTEGER :: i1, i2, ico, iset, jset, l, lshell, m, &
2501 maxco, ncgf, ng, ngs, np, nsgf
2502 INTEGER, DIMENSION(0:10) :: mxf
2503 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: gal, zal, zll
2504
2505 ng = gto_basis_set%npgf(1)
2506 DO iset = 1, nset
2507 IF ((ng /= gto_basis_set%npgf(iset)) .AND. do_ortho) THEN
2508 cpabort("different number of primitves")
2509 END IF
2510 END DO
2511
2512 IF (do_ortho) THEN
2513 mxf = 0
2514 DO iset = 1, nset
2515 l = gto_basis_set%l(1, iset)
2516 mxf(l) = mxf(l) + 1
2517 END DO
2518 m = maxval(mxf)
2519 IF (m > 1) THEN
2520 ALLOCATE (gal(ng, nset), zal(ng, nset), zll(m*ng, 0:maxl))
2521 DO iset = 1, nset
2522 zal(1:ng, iset) = gto_basis_set%zet(1:ng, iset)
2523 gal(1:ng, iset) = gto_basis_set%gcc(1:ng, 1, iset)
2524 END DO
2525 CALL reallocate(gto_basis_set%zet, 1, m*ng, 1, nset)
2526 CALL reallocate(gto_basis_set%gcc, 1, m*ng, 1, 1, 1, nset)
2527 DO iset = 1, nset
2528 l = gto_basis_set%l(1, iset)
2529 gto_basis_set%npgf(iset) = ng*mxf(l)
2530 END DO
2531 gto_basis_set%zet = 0.0_dp
2532 gto_basis_set%gcc = 0.0_dp
2533 zll = 0.0_dp
2534 mxf = 0
2535 DO iset = 1, nset
2536 l = gto_basis_set%l(1, iset)
2537 mxf(l) = mxf(l) + 1
2538 i1 = mxf(l)*ng - ng + 1
2539 i2 = mxf(l)*ng
2540 zll(i1:i2, l) = zal(1:ng, iset)
2541 gto_basis_set%gcc(i1:i2, 1, iset) = gal(1:ng, iset)
2542 END DO
2543 DO iset = 1, nset
2544 l = gto_basis_set%l(1, iset)
2545 gto_basis_set%zet(:, iset) = zll(:, l)
2546 END DO
2547 DO iset = 1, nset
2548 l = gto_basis_set%l(1, iset)
2549 DO jset = 1, iset - 1
2550 IF (gto_basis_set%l(1, iset) == l) THEN
2551 m = mxf(l)*ng
2552 CALL orthofun(gto_basis_set%zet(1:m, iset), gto_basis_set%gcc(1:m, 1, iset), &
2553 gto_basis_set%gcc(1:m, 1, jset), l)
2554 END IF
2555 END DO
2556 END DO
2557 DEALLOCATE (gal, zal, zll)
2558 END IF
2559 END IF
2560
2561 ngs = maxval(gto_basis_set%npgf(1:nset))
2562 CALL reallocate(gto_basis_set%set_radius, 1, nset)
2563 CALL reallocate(gto_basis_set%pgf_radius, 1, ngs, 1, nset)
2564 CALL reallocate(gto_basis_set%first_cgf, 1, 1, 1, nset)
2565 CALL reallocate(gto_basis_set%first_sgf, 1, 1, 1, nset)
2566 CALL reallocate(gto_basis_set%last_cgf, 1, 1, 1, nset)
2567 CALL reallocate(gto_basis_set%last_sgf, 1, 1, 1, nset)
2568 CALL reallocate(gto_basis_set%ncgf_set, 1, nset)
2569 CALL reallocate(gto_basis_set%nsgf_set, 1, nset)
2570
2571 maxco = 0
2572 ncgf = 0
2573 nsgf = 0
2574
2575 DO iset = 1, nset
2576 gto_basis_set%ncgf_set(iset) = 0
2577 gto_basis_set%nsgf_set(iset) = 0
2578 lshell = gto_basis_set%l(1, iset)
2579 gto_basis_set%first_cgf(1, iset) = ncgf + 1
2580 ncgf = ncgf + nco(lshell)
2581 gto_basis_set%last_cgf(1, iset) = ncgf
2582 gto_basis_set%ncgf_set(iset) = &
2583 gto_basis_set%ncgf_set(iset) + nco(lshell)
2584 gto_basis_set%first_sgf(1, iset) = nsgf + 1
2585 nsgf = nsgf + nso(lshell)
2586 gto_basis_set%last_sgf(1, iset) = nsgf
2587 gto_basis_set%nsgf_set(iset) = &
2588 gto_basis_set%nsgf_set(iset) + nso(lshell)
2589 ngs = gto_basis_set%npgf(iset)
2590 maxco = max(maxco, ngs*ncoset(lshell))
2591 END DO
2592
2593 gto_basis_set%ncgf = ncgf
2594 gto_basis_set%nsgf = nsgf
2595
2596 CALL reallocate(gto_basis_set%cphi, 1, maxco, 1, ncgf)
2597 CALL reallocate(gto_basis_set%sphi, 1, maxco, 1, nsgf)
2598 CALL reallocate(gto_basis_set%scon, 1, maxco, 1, nsgf)
2599 CALL reallocate(gto_basis_set%ccon, 1, maxco, 1, ncgf)
2600 CALL reallocate(gto_basis_set%lx, 1, ncgf)
2601 CALL reallocate(gto_basis_set%ly, 1, ncgf)
2602 CALL reallocate(gto_basis_set%lz, 1, ncgf)
2603 CALL reallocate(gto_basis_set%m, 1, nsgf)
2604 CALL reallocate(gto_basis_set%norm_cgf, 1, ncgf)
2605 ALLOCATE (gto_basis_set%cgf_symbol(ncgf))
2606 ALLOCATE (gto_basis_set%sgf_symbol(nsgf))
2607
2608 ncgf = 0
2609 nsgf = 0
2610
2611 DO iset = 1, nset
2612 lshell = gto_basis_set%l(1, iset)
2613 np = lshell + 1
2614 DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
2615 ncgf = ncgf + 1
2616 gto_basis_set%lx(ncgf) = indco(1, ico)
2617 gto_basis_set%ly(ncgf) = indco(2, ico)
2618 gto_basis_set%lz(ncgf) = indco(3, ico)
2619 gto_basis_set%cgf_symbol(ncgf) = &
2620 cgf_symbol(np, [gto_basis_set%lx(ncgf), &
2621 gto_basis_set%ly(ncgf), &
2622 gto_basis_set%lz(ncgf)])
2623 END DO
2624 DO m = -lshell, lshell
2625 nsgf = nsgf + 1
2626 gto_basis_set%m(nsgf) = m
2627 gto_basis_set%sgf_symbol(nsgf) = sgf_symbol(np, lshell, m)
2628 END DO
2629 END DO
2630
2631 gto_basis_set%norm_type = -1
2632
2633 END SUBROUTINE process_gto_basis
2634
2635! **************************************************************************************************
2636!> \brief ...
2637!> \param zet ...
2638!> \param co ...
2639!> \param cr ...
2640!> \param l ...
2641! **************************************************************************************************
2642 SUBROUTINE orthofun(zet, co, cr, l)
2643 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: zet
2644 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: co, cr
2645 INTEGER, INTENT(IN) :: l
2646
2647 REAL(kind=dp) :: ss
2648
2649 CALL aovlp(l, zet, cr, cr, ss)
2650 cr(:) = cr(:)/sqrt(ss)
2651 CALL aovlp(l, zet, co, cr, ss)
2652 co(:) = co(:) - ss*cr(:)
2653 CALL aovlp(l, zet, co, co, ss)
2654 co(:) = co(:)/sqrt(ss)
2655
2656 END SUBROUTINE orthofun
2657
2658! **************************************************************************************************
2659!> \brief ...
2660!> \param l ...
2661!> \param zet ...
2662!> \param ca ...
2663!> \param cb ...
2664!> \param ss ...
2665! **************************************************************************************************
2666 SUBROUTINE aovlp(l, zet, ca, cb, ss)
2667 INTEGER, INTENT(IN) :: l
2668 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: zet, ca, cb
2669 REAL(kind=dp), INTENT(OUT) :: ss
2670
2671 INTEGER :: i, j, m
2672 REAL(kind=dp) :: ab, ai, aj, s00, sss
2673
2674!
2675! use init_norm_cgf_orb
2676!
2677 m = SIZE(zet)
2678 ss = 0.0_dp
2679 DO i = 1, m
2680 ai = (2.0_dp*zet(i)/pi)**0.75_dp
2681 DO j = 1, m
2682 aj = (2.0_dp*zet(j)/pi)**0.75_dp
2683 ab = 1._dp/(zet(i) + zet(j))
2684 s00 = ai*aj*(pi*ab)**1.50_dp
2685 IF (l == 0) THEN
2686 sss = s00
2687 ELSE IF (l == 1) THEN
2688 sss = s00*ab*0.5_dp
2689 ELSE
2690 cpabort("aovlp lvalue")
2691 END IF
2692 ss = ss + sss*ca(i)*cb(j)
2693 END DO
2694 END DO
2695
2696 END SUBROUTINE aovlp
2697
2698! **************************************************************************************************
2699!> \brief ...
2700!> \param z ...
2701!> \param ne ...
2702!> \param n ...
2703!> \param l ...
2704!> \return ...
2705! **************************************************************************************************
2706 PURE FUNCTION srules(z, ne, n, l)
2707 ! Slater rules
2708 INTEGER, INTENT(IN) :: z
2709 INTEGER, DIMENSION(:, :), INTENT(IN) :: ne
2710 INTEGER, INTENT(IN) :: n, l
2711 REAL(dp) :: srules
2712
2713 REAL(dp), DIMENSION(7), PARAMETER :: &
2714 xns = [1.0_dp, 2.0_dp, 3.0_dp, 3.7_dp, 4.0_dp, 4.2_dp, 4.4_dp]
2715
2716 INTEGER :: i, l1, l2, m, m1, m2, nn
2717 REAL(dp) :: s
2718
2719 s = 0.0_dp
2720 ! The complete shell
2721 l1 = min(l + 1, 4)
2722 nn = min(n, 7)
2723 IF (l1 == 1) l2 = 2
2724 IF (l1 == 2) l2 = 1
2725 IF (l1 == 3) l2 = 4
2726 IF (l1 == 4) l2 = 3
2727 ! Rule a) no contribution from shells further out
2728 ! Rule b) 0.35 (1s 0.3) from each other electron in the same shell
2729 IF (n == 1) THEN
2730 m = ne(1, 1)
2731 s = s + 0.3_dp*real(m - 1, dp)
2732 ELSE
2733 m = ne(l1, nn) + ne(l2, nn)
2734 s = s + 0.35_dp*real(m - 1, dp)
2735 END IF
2736 ! Rule c) if (s,p) shell 0.85 from each electron with n-1, and 1.0
2737 ! from all electrons further in
2738 IF (l1 + l2 == 3) THEN
2739 IF (nn > 1) THEN
2740 m1 = ne(1, nn - 1) + ne(2, nn - 1) + ne(3, nn - 1) + ne(4, nn - 1)
2741 m2 = 0
2742 DO i = 1, nn - 2
2743 m2 = m2 + ne(1, i) + ne(2, i) + ne(3, i) + ne(4, i)
2744 END DO
2745 s = s + 0.85_dp*real(m1, dp) + 1._dp*real(m2, dp)
2746 END IF
2747 ELSE
2748 ! Rule d) if (d,f) shell 1.0 from each electron inside
2749 m = 0
2750 DO i = 1, nn - 1
2751 m = m + ne(1, i) + ne(2, i) + ne(3, i) + ne(4, i)
2752 END DO
2753 s = s + 1._dp*real(m, dp)
2754 END IF
2755 ! Slater exponent is (Z-S)/NS
2756 srules = (real(z, dp) - s)/xns(nn)
2757 END FUNCTION srules
2758
2759! **************************************************************************************************
2760!> \brief sort basis sets w.r.t. radius
2761!> \param basis_set ...
2762!> \param sort_method ...
2763! **************************************************************************************************
2764 SUBROUTINE sort_gto_basis_set(basis_set, sort_method)
2765 TYPE(gto_basis_set_type), INTENT(INOUT) :: basis_set
2766 INTEGER, INTENT(IN) :: sort_method
2767
2768 CHARACTER(LEN=12), DIMENSION(:), POINTER :: cgf_symbol
2769 CHARACTER(LEN=6), DIMENSION(:), POINTER :: sgf_symbol
2770 INTEGER :: ic, ic_max, icgf, icgf_new, icgf_old, ico, is, is_max, iset, isgf, isgf_new, &
2771 isgf_old, ishell, lshell, maxco, maxpgf, maxshell, mm, nc, ncgf, ns, nset
2772 INTEGER, ALLOCATABLE, DIMENSION(:) :: sort_index
2773 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: icgf_set, isgf_set
2774 INTEGER, DIMENSION(:), POINTER :: lx, ly, lz, m, npgf
2775 LOGICAL :: ccon_available
2776 REAL(dp), ALLOCATABLE, DIMENSION(:) :: tmp
2777 REAL(dp), DIMENSION(:), POINTER :: set_radius
2778 REAL(dp), DIMENSION(:, :), POINTER :: zet
2779 REAL(kind=dp), DIMENSION(:), POINTER :: norm_cgf
2780 REAL(kind=dp), DIMENSION(:, :), POINTER :: ccon, cphi, scon, sphi
2781
2782 NULLIFY (set_radius, zet)
2783
2784 IF (sort_method == basis_sort_default) RETURN
2785
2786 CALL get_gto_basis_set(gto_basis_set=basis_set, &
2787 nset=nset, &
2788 maxshell=maxshell, &
2789 maxpgf=maxpgf, &
2790 maxco=maxco, &
2791 ncgf=ncgf, &
2792 npgf=npgf, &
2793 set_radius=set_radius, &
2794 zet=zet)
2795
2796 ALLOCATE (sort_index(nset))
2797 ALLOCATE (tmp(nset))
2798 SELECT CASE (sort_method)
2799 CASE (basis_sort_zet)
2800 DO iset = 1, nset
2801 tmp(iset) = minval(basis_set%zet(:npgf(iset), iset))
2802 END DO
2803 CASE DEFAULT
2804 cpabort("Request basis sort criterion not implemented.")
2805 END SELECT
2806
2807 CALL sort(tmp(1:nset), nset, sort_index)
2808
2809 ic_max = 0
2810 is_max = 0
2811 DO iset = 1, nset
2812 ic = 0
2813 is = 0
2814 DO ishell = 1, basis_set%nshell(iset)
2815 DO ico = 1, nco(basis_set%l(ishell, iset))
2816 ic = ic + 1
2817 IF (ic > ic_max) ic_max = ic
2818 END DO
2819 lshell = basis_set%l(ishell, iset)
2820 DO mm = -lshell, lshell
2821 is = is + 1
2822 IF (is > is_max) is_max = is
2823 END DO
2824 END DO
2825 END DO
2826
2827 icgf = 0
2828 isgf = 0
2829 ALLOCATE (icgf_set(nset, ic_max))
2830 icgf_set(:, :) = 0
2831 ALLOCATE (isgf_set(nset, is_max))
2832 isgf_set(:, :) = 0
2833
2834 DO iset = 1, nset
2835 ic = 0
2836 is = 0
2837 DO ishell = 1, basis_set%nshell(iset)
2838 DO ico = 1, nco(basis_set%l(ishell, iset))
2839 icgf = icgf + 1
2840 ic = ic + 1
2841 icgf_set(iset, ic) = icgf
2842 END DO
2843 lshell = basis_set%l(ishell, iset)
2844 DO mm = -lshell, lshell
2845 isgf = isgf + 1
2846 is = is + 1
2847 isgf_set(iset, is) = isgf
2848 END DO
2849 END DO
2850 END DO
2851
2852 ALLOCATE (cgf_symbol(SIZE(basis_set%cgf_symbol)))
2853 ALLOCATE (norm_cgf(SIZE(basis_set%norm_cgf)))
2854 ALLOCATE (lx(SIZE(basis_set%lx)))
2855 ALLOCATE (ly(SIZE(basis_set%ly)))
2856 ALLOCATE (lz(SIZE(basis_set%lz)))
2857 ALLOCATE (cphi(SIZE(basis_set%cphi, 1), SIZE(basis_set%cphi, 2)))
2858 cphi = 0.0_dp
2859 ALLOCATE (sphi(SIZE(basis_set%sphi, 1), SIZE(basis_set%sphi, 2)))
2860 sphi = 0.0_dp
2861 ALLOCATE (scon(SIZE(basis_set%scon, 1), SIZE(basis_set%scon, 2)))
2862 scon = 0.0_dp
2863 ALLOCATE (ccon(SIZE(basis_set%cphi, 1), SIZE(basis_set%cphi, 2)))
2864 ccon = 0.0_dp
2865 ccon_available = ASSOCIATED(basis_set%ccon)
2866 IF (ccon_available) THEN
2867 ccon_available = (SIZE(basis_set%ccon, 1) == SIZE(ccon, 1)) .AND. &
2868 (SIZE(basis_set%ccon, 2) == SIZE(ccon, 2))
2869 END IF
2870
2871 ALLOCATE (sgf_symbol(SIZE(basis_set%sgf_symbol)))
2872 ALLOCATE (m(SIZE(basis_set%m)))
2873
2874 icgf_new = 0
2875 isgf_new = 0
2876 DO iset = 1, nset
2877 DO ic = 1, ic_max
2878 icgf_old = icgf_set(sort_index(iset), ic)
2879 IF (icgf_old == 0) cycle
2880 icgf_new = icgf_new + 1
2881 norm_cgf(icgf_new) = basis_set%norm_cgf(icgf_old)
2882 lx(icgf_new) = basis_set%lx(icgf_old)
2883 ly(icgf_new) = basis_set%ly(icgf_old)
2884 lz(icgf_new) = basis_set%lz(icgf_old)
2885 cphi(:, icgf_new) = basis_set%cphi(:, icgf_old)
2886 IF (ccon_available) ccon(:, icgf_new) = basis_set%ccon(:, icgf_old)
2887 cgf_symbol(icgf_new) = basis_set%cgf_symbol(icgf_old)
2888 END DO
2889 DO is = 1, is_max
2890 isgf_old = isgf_set(sort_index(iset), is)
2891 IF (isgf_old == 0) cycle
2892 isgf_new = isgf_new + 1
2893 m(isgf_new) = basis_set%m(isgf_old)
2894 sphi(:, isgf_new) = basis_set%sphi(:, isgf_old)
2895 scon(:, isgf_new) = basis_set%scon(:, isgf_old)
2896 sgf_symbol(isgf_new) = basis_set%sgf_symbol(isgf_old)
2897 END DO
2898 END DO
2899
2900 DEALLOCATE (basis_set%cgf_symbol)
2901 basis_set%cgf_symbol => cgf_symbol
2902 DEALLOCATE (basis_set%norm_cgf)
2903 basis_set%norm_cgf => norm_cgf
2904 DEALLOCATE (basis_set%lx)
2905 basis_set%lx => lx
2906 DEALLOCATE (basis_set%ly)
2907 basis_set%ly => ly
2908 DEALLOCATE (basis_set%lz)
2909 basis_set%lz => lz
2910 DEALLOCATE (basis_set%cphi)
2911 basis_set%cphi => cphi
2912 DEALLOCATE (basis_set%sphi)
2913 basis_set%sphi => sphi
2914 DEALLOCATE (basis_set%scon)
2915 basis_set%scon => scon
2916 IF (ASSOCIATED(basis_set%ccon)) DEALLOCATE (basis_set%ccon)
2917 basis_set%ccon => ccon
2918
2919 DEALLOCATE (basis_set%m)
2920 basis_set%m => m
2921 DEALLOCATE (basis_set%sgf_symbol)
2922 basis_set%sgf_symbol => sgf_symbol
2923
2924 basis_set%lmax = basis_set%lmax(sort_index)
2925 basis_set%lmin = basis_set%lmin(sort_index)
2926 basis_set%npgf = basis_set%npgf(sort_index)
2927 basis_set%nshell = basis_set%nshell(sort_index)
2928 basis_set%ncgf_set = basis_set%ncgf_set(sort_index)
2929 basis_set%nsgf_set = basis_set%nsgf_set(sort_index)
2930
2931 basis_set%n(:, :) = basis_set%n(:, sort_index)
2932 basis_set%l(:, :) = basis_set%l(:, sort_index)
2933 basis_set%zet(:, :) = basis_set%zet(:, sort_index)
2934
2935 basis_set%gcc(:, :, :) = basis_set%gcc(:, :, sort_index)
2936 basis_set%set_radius(:) = basis_set%set_radius(sort_index)
2937 basis_set%pgf_radius(:, :) = basis_set%pgf_radius(:, sort_index)
2938
2939 nc = 0
2940 ns = 0
2941 DO iset = 1, nset
2942 DO ishell = 1, basis_set%nshell(iset)
2943 lshell = basis_set%l(ishell, iset)
2944 basis_set%first_cgf(ishell, iset) = nc + 1
2945 nc = nc + nco(lshell)
2946 basis_set%last_cgf(ishell, iset) = nc
2947 basis_set%first_sgf(ishell, iset) = ns + 1
2948 ns = ns + nso(lshell)
2949 basis_set%last_sgf(ishell, iset) = ns
2950 END DO
2951 END DO
2952
2953 END SUBROUTINE sort_gto_basis_set
2954
2955END MODULE basis_set_types
dgemm
static void dgemm(const char transa, const char transb, const int m, const int n, const int k, const double alpha, const double *a, const int lda, const double *b, const int ldb, const double beta, double *c, const int ldc)
Convenient wrapper to hide Fortran nature of dgemm_, swapping a and b.
Definition grid_cpu_task_list.c:225
basis_set_types::read_gto_basis_set
Definition basis_set_types.F:111
cp_parser_methods::parser_get_object
Definition cp_parser_methods.F:54
memory_utilities::reallocate
Definition memory_utilities.F:27
ai_coulomb
Calculation of Coulomb integrals over Cartesian Gaussian-type functions (electron repulsion integrals...
Definition ai_coulomb.F:41
ai_coulomb::coulomb2
subroutine, public coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpgfc, lc_min, rac, rac2, vac, v, f, maxder, vac_plus)
Calculation of the primitive two-center Coulomb integrals over Cartesian Gaussian-type functions.
Definition ai_coulomb.F:86
basis_set_types
Definition basis_set_types.F:15
basis_set_types::get_gto_basis_set
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum, ccon)
...
Definition basis_set_types.F:643
basis_set_types::basis_sort_zet
integer, parameter, public basis_sort_zet
Definition basis_set_types.F:66
basis_set_types::process_gto_basis
subroutine, public process_gto_basis(gto_basis_set, do_ortho, nset, maxl)
...
Definition basis_set_types.F:2495
basis_set_types::init_cphi_and_sphi
subroutine, public init_cphi_and_sphi(gto_basis_set, lccon)
...
Definition basis_set_types.F:818
basis_set_types::deallocate_gto_basis_set
subroutine, public deallocate_gto_basis_set(gto_basis_set)
...
Definition basis_set_types.F:170
basis_set_types::srules
pure real(dp) function, public srules(z, ne, n, l)
...
Definition basis_set_types.F:2707
basis_set_types::write_orb_basis_set
subroutine, public write_orb_basis_set(orb_basis_set, output_unit, header)
Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
Definition basis_set_types.F:1984
basis_set_types::sort_gto_basis_set
subroutine, public sort_gto_basis_set(basis_set, sort_method)
sort basis sets w.r.t. radius
Definition basis_set_types.F:2765
basis_set_types::set_gto_basis_set
subroutine, public set_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, short_kind_radius, ccon)
Set the components of Gaussian-type orbital (GTO) basis set data set.
Definition basis_set_types.F:1858
basis_set_types::deallocate_sto_basis_set
subroutine, public deallocate_sto_basis_set(sto_basis_set)
...
Definition basis_set_types.F:2136
basis_set_types::init_aux_basis_set
subroutine, public init_aux_basis_set(gto_basis_set)
...
Definition basis_set_types.F:776
basis_set_types::allocate_gto_basis_set
subroutine, public allocate_gto_basis_set(gto_basis_set)
...
Definition basis_set_types.F:152
basis_set_types::copy_gto_basis_set
subroutine, public copy_gto_basis_set(basis_set_in, basis_set_out)
...
Definition basis_set_types.F:215
basis_set_types::combine_basis_sets
subroutine, public combine_basis_sets(basis_set, basis_set_add)
...
Definition basis_set_types.F:472
basis_set_types::write_gto_basis_set
subroutine, public write_gto_basis_set(gto_basis_set, output_unit, header)
Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
Definition basis_set_types.F:1924
basis_set_types::allocate_sto_basis_set
subroutine, public allocate_sto_basis_set(sto_basis_set)
...
Definition basis_set_types.F:2122
basis_set_types::create_primitive_basis_set
subroutine, public create_primitive_basis_set(basis_set, pbasis, lmax)
...
Definition basis_set_types.F:294
basis_set_types::dump_gto_basis_set
subroutine, public dump_gto_basis_set(gto_basis_set, output_unit)
...
Definition basis_set_types.F:2043
basis_set_types::create_gto_from_sto_basis
subroutine, public create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho)
...
Definition basis_set_types.F:2426
basis_set_types::set_sto_basis_set
subroutine, public set_sto_basis_set(sto_basis_set, name, nshell, symbol, nq, lq, zet)
...
Definition basis_set_types.F:2213
basis_set_types::read_sto_basis_set
subroutine, public read_sto_basis_set(element_symbol, basis_set_name, sto_basis_set, para_env, dft_section)
...
Definition basis_set_types.F:2259
basis_set_types::init_orb_basis_set
subroutine, public init_orb_basis_set(gto_basis_set)
Initialise a Gaussian-type orbital (GTO) basis set data set.
Definition basis_set_types.F:1138
basis_set_types::basis_sort_default
integer, parameter, public basis_sort_default
Definition basis_set_types.F:66
bibliography
collects all references to literature in CP2K as new algorithms / method are included from literature...
Definition bibliography.F:21
bibliography::vandevondele2007
integer, save, public vandevondele2007
Definition bibliography.F:36
cp_linked_list_input
Definition cp_linked_list_input.F:9
cp_linked_list_input::cp_sll_val_next
logical function, public cp_sll_val_next(iterator, el_att)
returns true if the actual element is valid (i.e. iterator ont at end) moves the iterator to the next...
Definition cp_linked_list_input.F:1475
cp_parser_methods
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_methods.F:20
cp_parser_methods::parser_search_string
subroutine, public parser_search_string(parser, string, ignore_case, found, line, begin_line, search_from_begin_of_file)
Search a string pattern in a file defined by its logical unit number "unit". A case sensitive search ...
Definition cp_parser_methods.F:787
cp_parser_types
Utility routines to read data from files. Kept as close as possible to the old parser because.
Definition cp_parser_types.F:21
cp_parser_types::parser_release
subroutine, public parser_release(parser)
releases the parser
Definition cp_parser_types.F:109
cp_parser_types::parser_create
subroutine, public parser_create(parser, file_name, unit_nr, para_env, end_section_label, separator_chars, comment_char, continuation_char, quote_char, section_char, parse_white_lines, initial_variables, apply_preprocessing)
Start a parser run. Initial variables allow to @SET stuff before opening the file.
Definition cp_parser_types.F:147
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_vals_list_get
subroutine, public section_vals_list_get(section_vals, keyword_name, i_rep_section, list)
returns the requested list
Definition input_section_types.F:1164
input_section_types::section_vals_val_get
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Definition input_section_types.F:1052
input_val_types
a wrapper for basic fortran types.
Definition input_val_types.F:14
input_val_types::val_get
subroutine, public val_get(val, has_l, has_i, has_r, has_lc, has_c, l_val, l_vals, i_val, i_vals, r_val, r_vals, c_val, c_vals, len_c, type_of_var, enum)
returns the stored values
Definition input_val_types.F:334
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
list
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition mathconstants.F:110
mathconstants::dfac
real(kind=dp), dimension(-1:2 *maxfac+1), parameter, public dfac
Definition mathconstants.F:61
memory_utilities
Utility routines for the memory handling.
Definition memory_utilities.F:14
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
orbital_pointers
Provides Cartesian and spherical orbital pointers and indices.
Definition orbital_pointers.F:15
orbital_pointers::init_orbital_pointers
subroutine, public init_orbital_pointers(maxl)
Initialize or update the orbital pointers.
Definition orbital_pointers.F:253
orbital_pointers::co
integer, dimension(:, :, :), allocatable, public co
Definition orbital_pointers.F:45
orbital_pointers::nco
integer, dimension(:), allocatable, public nco
Definition orbital_pointers.F:42
orbital_pointers::nsoset
integer, dimension(:), allocatable, public nsoset
Definition orbital_pointers.F:42
orbital_pointers::ncoset
integer, dimension(:), allocatable, public ncoset
Definition orbital_pointers.F:42
orbital_pointers::coset
integer, dimension(:, :, :), allocatable, public coset
Definition orbital_pointers.F:45
orbital_pointers::indco
integer, dimension(:, :), allocatable, public indco
Definition orbital_pointers.F:43
orbital_pointers::nso
integer, dimension(:), allocatable, public nso
Definition orbital_pointers.F:42
orbital_symbols
orbital_symbols
Definition orbital_symbols.F:14
orbital_symbols::cgf_symbol
character(len=12) function, public cgf_symbol(n, lxyz)
Build a Cartesian orbital symbol (orbital labels for printing).
Definition orbital_symbols.F:44
orbital_symbols::sgf_symbol
character(len=6) function, public sgf_symbol(n, l, m)
Build a spherical orbital symbol (orbital labels for printing).
Definition orbital_symbols.F:107
orbital_transformation_matrices
Calculation of the spherical harmonics and the corresponding orbital transformation matrices.
Definition orbital_transformation_matrices.F:17
orbital_transformation_matrices::init_spherical_harmonics
subroutine, public init_spherical_harmonics(maxl, output_unit)
Initialize or update the orbital transformation matrices.
Definition orbital_transformation_matrices.F:255
orbital_transformation_matrices::orbtramat
type(orbtramat_type), dimension(:), pointer, public orbtramat
Definition orbital_transformation_matrices.F:47
sto_ng
Definition sto_ng.F:13
sto_ng::get_sto_ng
subroutine, public get_sto_ng(zeta, n, nq, lq, alpha, coef)
return STO-NG parameters; INPUT: zeta (Slater exponent) n (Expansion length) nq (principle quantum nu...
Definition sto_ng.F:54
string_utilities
Utilities for string manipulations.
Definition string_utilities.F:16
string_utilities::integer_to_string
subroutine, public integer_to_string(inumber, string)
Converts an integer number to a string. The WRITE statement will return an error message,...
Definition string_utilities.F:3239
string_utilities::newline
character(len=1), parameter, public newline
Definition string_utilities.F:29
string_utilities::remove_word
subroutine, public remove_word(string)
remove a word from a string (words are separated by white spaces)
Definition string_utilities.F:3275
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3362
util
All kind of helpful little routines.
Definition util.F:14
basis_set_types::gto_basis_set_p_type
Definition basis_set_types.F:94
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72
basis_set_types::sto_basis_set_type
Definition basis_set_types.F:101
cp_linked_list_input::cp_sll_val_type
represent a single linked list that stores pointers to the elements
Definition cp_linked_list_input.F:341
cp_parser_types::cp_parser_type
represent a parser
Definition cp_parser_types.F:77
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
input_val_types::val_type
a type to have a wrapper that stores any basic fortran type
Definition input_val_types.F:63
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:746