(git:e8f5963)
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) &
1684 cpabort("Error reading the Basis from input file!")
1685 DO ipgf = 1, npgf(iset)
1686 is_ok = cp_sll_val_next(list, val)
1687 IF (.NOT. is_ok) cpabort("Error reading the Basis set from input file!")
1688 CALL val_get(val, c_val=line_att)
1689 READ (line_att, *) zet(ipgf, iset), (gcc(ipgf, ishell, iset), ishell=1, nshell(iset))
1690 END DO
1691 END DO
1692
1693 ! Maximum angular momentum quantum number of the atomic kind
1694
1695 CALL init_orbital_pointers(maxl)
1696
1697 ! Allocate the global variables
1698
1699 gto_basis_set%nset = nset
1700 CALL reallocate(gto_basis_set%lmax, 1, nset)
1701 CALL reallocate(gto_basis_set%lmin, 1, nset)
1702 CALL reallocate(gto_basis_set%npgf, 1, nset)
1703 CALL reallocate(gto_basis_set%nshell, 1, nset)
1704 CALL reallocate(gto_basis_set%n, 1, maxshell, 1, nset)
1705 CALL reallocate(gto_basis_set%l, 1, maxshell, 1, nset)
1706 CALL reallocate(gto_basis_set%zet, 1, maxpgf, 1, nset)
1707 CALL reallocate(gto_basis_set%gcc, 1, maxpgf, 1, maxshell, 1, nset)
1708
1709 ! Copy the basis set information into the data structure
1710
1711 DO iset = 1, nset
1712 gto_basis_set%lmax(iset) = lmax(iset)
1713 gto_basis_set%lmin(iset) = lmin(iset)
1714 gto_basis_set%npgf(iset) = npgf(iset)
1715 gto_basis_set%nshell(iset) = nshell(iset)
1716 DO ishell = 1, nshell(iset)
1717 gto_basis_set%n(ishell, iset) = n(ishell, iset)
1718 gto_basis_set%l(ishell, iset) = l(ishell, iset)
1719 DO ipgf = 1, npgf(iset)
1720 gto_basis_set%gcc(ipgf, ishell, iset) = gcc(ipgf, ishell, iset)
1721 END DO
1722 END DO
1723 DO ipgf = 1, npgf(iset)
1724 gto_basis_set%zet(ipgf, iset) = zet(ipgf, iset)
1725 END DO
1726 END DO
1727
1728 ! Initialise the depending atomic kind information
1729
1730 CALL reallocate(gto_basis_set%set_radius, 1, nset)
1731 CALL reallocate(gto_basis_set%pgf_radius, 1, maxpgf, 1, nset)
1732 CALL reallocate(gto_basis_set%first_cgf, 1, maxshell, 1, nset)
1733 CALL reallocate(gto_basis_set%first_sgf, 1, maxshell, 1, nset)
1734 CALL reallocate(gto_basis_set%last_cgf, 1, maxshell, 1, nset)
1735 CALL reallocate(gto_basis_set%last_sgf, 1, maxshell, 1, nset)
1736 CALL reallocate(gto_basis_set%ncgf_set, 1, nset)
1737 CALL reallocate(gto_basis_set%nsgf_set, 1, nset)
1738
1739 maxco = 0
1740 ncgf = 0
1741 nsgf = 0
1742
1743 DO iset = 1, nset
1744 gto_basis_set%ncgf_set(iset) = 0
1745 gto_basis_set%nsgf_set(iset) = 0
1746 DO ishell = 1, nshell(iset)
1747 lshell = gto_basis_set%l(ishell, iset)
1748 gto_basis_set%first_cgf(ishell, iset) = ncgf + 1
1749 ncgf = ncgf + nco(lshell)
1750 gto_basis_set%last_cgf(ishell, iset) = ncgf
1751 gto_basis_set%ncgf_set(iset) = &
1752 gto_basis_set%ncgf_set(iset) + nco(lshell)
1753 gto_basis_set%first_sgf(ishell, iset) = nsgf + 1
1754 nsgf = nsgf + nso(lshell)
1755 gto_basis_set%last_sgf(ishell, iset) = nsgf
1756 gto_basis_set%nsgf_set(iset) = &
1757 gto_basis_set%nsgf_set(iset) + nso(lshell)
1758 END DO
1759 maxco = max(maxco, npgf(iset)*ncoset(lmax(iset)))
1760 END DO
1761
1762 gto_basis_set%ncgf = ncgf
1763 gto_basis_set%nsgf = nsgf
1764
1765 CALL reallocate(gto_basis_set%cphi, 1, maxco, 1, ncgf)
1766 CALL reallocate(gto_basis_set%sphi, 1, maxco, 1, nsgf)
1767 CALL reallocate(gto_basis_set%scon, 1, maxco, 1, nsgf)
1768 CALL reallocate(gto_basis_set%ccon, 1, maxco, 1, ncgf)
1769 CALL reallocate(gto_basis_set%lx, 1, ncgf)
1770 CALL reallocate(gto_basis_set%ly, 1, ncgf)
1771 CALL reallocate(gto_basis_set%lz, 1, ncgf)
1772 CALL reallocate(gto_basis_set%m, 1, nsgf)
1773 CALL reallocate(gto_basis_set%norm_cgf, 1, ncgf)
1774 ALLOCATE (gto_basis_set%cgf_symbol(ncgf))
1775
1776 ALLOCATE (gto_basis_set%sgf_symbol(nsgf))
1777
1778 ncgf = 0
1779 nsgf = 0
1780
1781 DO iset = 1, nset
1782 DO ishell = 1, nshell(iset)
1783 lshell = gto_basis_set%l(ishell, iset)
1784 DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
1785 ncgf = ncgf + 1
1786 gto_basis_set%lx(ncgf) = indco(1, ico)
1787 gto_basis_set%ly(ncgf) = indco(2, ico)
1788 gto_basis_set%lz(ncgf) = indco(3, ico)
1789 gto_basis_set%cgf_symbol(ncgf) = &
1790 cgf_symbol(n(ishell, iset), [gto_basis_set%lx(ncgf), &
1791 gto_basis_set%ly(ncgf), &
1792 gto_basis_set%lz(ncgf)])
1793 END DO
1794 DO m = -lshell, lshell
1795 nsgf = nsgf + 1
1796 gto_basis_set%m(nsgf) = m
1797 gto_basis_set%sgf_symbol(nsgf) = &
1798 sgf_symbol(n(ishell, iset), lshell, m)
1799 END DO
1800 END DO
1801 END DO
1802
1803 DEALLOCATE (gcc, l, lmax, lmin, n, npgf, nshell, zet)
1804
1805 IF (PRESENT(dft_section)) THEN
1806 CALL section_vals_val_get(dft_section, "SORT_BASIS", i_val=sort_method)
1807 CALL sort_gto_basis_set(gto_basis_set, sort_method)
1808 END IF
1809
1810 END SUBROUTINE read_gto_basis_set2
1811
1812! **************************************************************************************************
1813!> \brief Set the components of Gaussian-type orbital (GTO) basis set data set.
1814!> \param gto_basis_set ...
1815!> \param name ...
1816!> \param aliases ...
1817!> \param norm_type ...
1818!> \param kind_radius ...
1819!> \param ncgf ...
1820!> \param nset ...
1821!> \param nsgf ...
1822!> \param cgf_symbol ...
1823!> \param sgf_symbol ...
1824!> \param norm_cgf ...
1825!> \param set_radius ...
1826!> \param lmax ...
1827!> \param lmin ...
1828!> \param lx ...
1829!> \param ly ...
1830!> \param lz ...
1831!> \param m ...
1832!> \param ncgf_set ...
1833!> \param npgf ...
1834!> \param nsgf_set ...
1835!> \param nshell ...
1836!> \param cphi ...
1837!> \param pgf_radius ...
1838!> \param sphi ...
1839!> \param scon ...
1840!> \param zet ...
1841!> \param first_cgf ...
1842!> \param first_sgf ...
1843!> \param l ...
1844!> \param last_cgf ...
1845!> \param last_sgf ...
1846!> \param n ...
1847!> \param gcc ...
1848!> \param short_kind_radius ...
1849!> \param ccon ...
1850!> \author MK
1851! **************************************************************************************************
1852 SUBROUTINE set_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, &
1853 nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, &
1854 lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, &
1855 cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, &
1856 last_cgf, last_sgf, n, gcc, short_kind_radius, ccon)
1857
1858 TYPE(gto_basis_set_type), INTENT(INOUT) :: gto_basis_set
1859 CHARACTER(LEN=default_string_length), INTENT(IN), &
1860 OPTIONAL :: name, aliases
1861 INTEGER, INTENT(IN), OPTIONAL :: norm_type
1862 REAL(kind=dp), INTENT(IN), OPTIONAL :: kind_radius
1863 INTEGER, INTENT(IN), OPTIONAL :: ncgf, nset, nsgf
1864 CHARACTER(LEN=12), DIMENSION(:), OPTIONAL, POINTER :: cgf_symbol
1865 CHARACTER(LEN=6), DIMENSION(:), OPTIONAL, POINTER :: sgf_symbol
1866 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: norm_cgf, set_radius
1867 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: lmax, lmin, lx, ly, lz, m, ncgf_set, &
1868 npgf, nsgf_set, nshell
1869 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: cphi, pgf_radius, sphi, scon, zet
1870 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: first_cgf, first_sgf, l, last_cgf, &
1871 last_sgf, n
1872 REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
1873 POINTER :: gcc
1874 REAL(kind=dp), INTENT(IN), OPTIONAL :: short_kind_radius
1875 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: ccon
1876
1877 IF (PRESENT(name)) gto_basis_set%name = name
1878 IF (PRESENT(aliases)) gto_basis_set%aliases = aliases
1879 IF (PRESENT(norm_type)) gto_basis_set%norm_type = norm_type
1880 IF (PRESENT(kind_radius)) gto_basis_set%kind_radius = kind_radius
1881 IF (PRESENT(short_kind_radius)) gto_basis_set%short_kind_radius = short_kind_radius
1882 IF (PRESENT(ncgf)) gto_basis_set%ncgf = ncgf
1883 IF (PRESENT(nset)) gto_basis_set%nset = nset
1884 IF (PRESENT(nsgf)) gto_basis_set%nsgf = nsgf
1885 IF (PRESENT(cgf_symbol)) gto_basis_set%cgf_symbol(:) = cgf_symbol(:)
1886 IF (PRESENT(sgf_symbol)) gto_basis_set%sgf_symbol(:) = sgf_symbol(:)
1887 IF (PRESENT(norm_cgf)) gto_basis_set%norm_cgf(:) = norm_cgf(:)
1888 IF (PRESENT(set_radius)) gto_basis_set%set_radius(:) = set_radius(:)
1889 IF (PRESENT(lmax)) gto_basis_set%lmax(:) = lmax(:)
1890 IF (PRESENT(lmin)) gto_basis_set%lmin(:) = lmin(:)
1891 IF (PRESENT(lx)) gto_basis_set%lx(:) = lx(:)
1892 IF (PRESENT(ly)) gto_basis_set%ly(:) = ly(:)
1893 IF (PRESENT(lz)) gto_basis_set%lz(:) = lz(:)
1894 IF (PRESENT(m)) gto_basis_set%m(:) = m(:)
1895 IF (PRESENT(ncgf_set)) gto_basis_set%ncgf_set(:) = ncgf_set(:)
1896 IF (PRESENT(npgf)) gto_basis_set%npgf(:) = npgf(:)
1897 IF (PRESENT(nsgf_set)) gto_basis_set%nsgf_set(:) = nsgf_set(:)
1898 IF (PRESENT(nshell)) gto_basis_set%nshell(:) = nshell(:)
1899 IF (PRESENT(cphi)) gto_basis_set%cphi(:, :) = cphi(:, :)
1900 IF (PRESENT(pgf_radius)) gto_basis_set%pgf_radius(:, :) = pgf_radius(:, :)
1901 IF (PRESENT(sphi)) gto_basis_set%sphi(:, :) = sphi(:, :)
1902 IF (PRESENT(scon)) gto_basis_set%scon(:, :) = scon(:, :)
1903 IF (PRESENT(ccon)) gto_basis_set%ccon(:, :) = ccon(:, :)
1904 IF (PRESENT(zet)) gto_basis_set%zet(:, :) = zet(:, :)
1905 IF (PRESENT(first_cgf)) gto_basis_set%first_cgf(:, :) = first_cgf(:, :)
1906 IF (PRESENT(first_sgf)) gto_basis_set%first_sgf(:, :) = first_sgf(:, :)
1907 IF (PRESENT(l)) l(:, :) = gto_basis_set%l(:, :)
1908 IF (PRESENT(last_cgf)) gto_basis_set%last_cgf(:, :) = last_cgf(:, :)
1909 IF (PRESENT(last_sgf)) gto_basis_set%last_sgf(:, :) = last_sgf(:, :)
1910 IF (PRESENT(n)) gto_basis_set%n(:, :) = n(:, :)
1911 IF (PRESENT(gcc)) gto_basis_set%gcc(:, :, :) = gcc(:, :, :)
1912
1913 END SUBROUTINE set_gto_basis_set
1914
1915! **************************************************************************************************
1916!> \brief Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
1917!> \param gto_basis_set ...
1918!> \param output_unit ...
1919!> \param header ...
1920!> \author MK
1921! **************************************************************************************************
1922 SUBROUTINE write_gto_basis_set(gto_basis_set, output_unit, header)
1923
1924 TYPE(gto_basis_set_type), INTENT(IN) :: gto_basis_set
1925 INTEGER, INTENT(in) :: output_unit
1926 CHARACTER(len=*), OPTIONAL :: header
1927
1928 INTEGER :: ipgf, iset, ishell
1929
1930 IF (output_unit > 0) THEN
1931
1932 IF (PRESENT(header)) THEN
1933 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40)") &
1934 trim(header), trim(gto_basis_set%name)
1935 END IF
1936
1937 WRITE (unit=output_unit, fmt="(/,(T8,A,T71,I10))") &
1938 "Number of orbital shell sets: ", &
1939 gto_basis_set%nset, &
1940 "Number of orbital shells: ", &
1941 sum(gto_basis_set%nshell(:)), &
1942 "Number of primitive Cartesian functions: ", &
1943 sum(gto_basis_set%npgf(:)), &
1944 "Number of Cartesian basis functions: ", &
1945 gto_basis_set%ncgf, &
1946 "Number of spherical basis functions: ", &
1947 gto_basis_set%nsgf, &
1948 "Norm type: ", &
1949 gto_basis_set%norm_type
1950
1951 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40,/,/,T25,A)") &
1952 "GTO basis set information for", trim(gto_basis_set%name), &
1953 "Set Shell n l Exponent Coefficient"
1954
1955 DO iset = 1, gto_basis_set%nset
1956 WRITE (unit=output_unit, fmt="(A)") ""
1957 DO ishell = 1, gto_basis_set%nshell(iset)
1958 WRITE (unit=output_unit, &
1959 fmt="(T25,I3,4X,I4,4X,I2,2X,I2,(T51,2F15.6))") &
1960 iset, ishell, &
1961 gto_basis_set%n(ishell, iset), &
1962 gto_basis_set%l(ishell, iset), &
1963 (gto_basis_set%zet(ipgf, iset), &
1964 gto_basis_set%gcc(ipgf, ishell, iset), &
1965 ipgf=1, gto_basis_set%npgf(iset))
1966 END DO
1967 END DO
1968
1969 END IF
1970
1971 END SUBROUTINE write_gto_basis_set
1972
1973! **************************************************************************************************
1974
1975! **************************************************************************************************
1976!> \brief Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
1977!> \param orb_basis_set ...
1978!> \param output_unit ...
1979!> \param header ...
1980!> \author MK
1981! **************************************************************************************************
1982 SUBROUTINE write_orb_basis_set(orb_basis_set, output_unit, header)
1983
1984 TYPE(gto_basis_set_type), INTENT(IN) :: orb_basis_set
1985 INTEGER, INTENT(in) :: output_unit
1986 CHARACTER(len=*), OPTIONAL :: header
1987
1988 INTEGER :: icgf, ico, ipgf, iset, ishell
1989
1990 IF (output_unit > 0) THEN
1991 IF (PRESENT(header)) THEN
1992 WRITE (unit=output_unit, fmt="(/,T6,A,T41,A40)") &
1993 trim(header), trim(orb_basis_set%name)
1994 END IF
1995
1996 WRITE (unit=output_unit, fmt="(/,(T8,A,T71,I10))") &
1997 "Number of orbital shell sets: ", &
1998 orb_basis_set%nset, &
1999 "Number of orbital shells: ", &
2000 sum(orb_basis_set%nshell(:)), &
2001 "Number of primitive Cartesian functions: ", &
2002 sum(orb_basis_set%npgf(:)), &
2003 "Number of Cartesian basis functions: ", &
2004 orb_basis_set%ncgf, &
2005 "Number of spherical basis functions: ", &
2006 orb_basis_set%nsgf, &
2007 "Norm type: ", &
2008 orb_basis_set%norm_type
2009
2010 WRITE (unit=output_unit, fmt="(/,T8,A,/,/,T25,A)") &
2011 "Normalised Cartesian orbitals:", &
2012 "Set Shell Orbital Exponent Coefficient"
2013
2014 icgf = 0
2015
2016 DO iset = 1, orb_basis_set%nset
2017 DO ishell = 1, orb_basis_set%nshell(iset)
2018 WRITE (unit=output_unit, fmt="(A)") ""
2019 DO ico = 1, nco(orb_basis_set%l(ishell, iset))
2020 icgf = icgf + 1
2021 WRITE (unit=output_unit, &
2022 fmt="(T25,I3,4X,I4,3X,A12,(T51,2F15.6))") &
2023 iset, ishell, orb_basis_set%cgf_symbol(icgf), &
2024 (orb_basis_set%zet(ipgf, iset), &
2025 orb_basis_set%norm_cgf(icgf)* &
2026 orb_basis_set%gcc(ipgf, ishell, iset), &
2027 ipgf=1, orb_basis_set%npgf(iset))
2028 END DO
2029 END DO
2030 END DO
2031 END IF
2032
2033 END SUBROUTINE write_orb_basis_set
2034
2035! **************************************************************************************************
2036!> \brief ...
2037!> \param gto_basis_set ...
2038!> \param output_unit ...
2039!> \author JGH
2040! **************************************************************************************************
2041 SUBROUTINE dump_gto_basis_set(gto_basis_set, output_unit)
2042
2043 TYPE(gto_basis_set_type), INTENT(IN) :: gto_basis_set
2044 INTEGER, INTENT(in) :: output_unit
2045
2046 INTEGER :: ipgf, iset, ishell
2047
2048 IF (output_unit > 0) THEN
2049
2050 WRITE (unit=output_unit, fmt="(/,T6,A40)") trim(gto_basis_set%name)
2051 WRITE (unit=output_unit, fmt="(/,T6,A40)") trim(gto_basis_set%aliases)
2052 WRITE (unit=output_unit, fmt="(/,T6,F12.8)") gto_basis_set%kind_radius
2053 WRITE (unit=output_unit, fmt="(/,T6,F12.8)") gto_basis_set%short_kind_radius
2054 WRITE (unit=output_unit, fmt="(/,T6,I8)") gto_basis_set%norm_type
2055 WRITE (unit=output_unit, fmt="(/,T6,3I8)") gto_basis_set%ncgf, gto_basis_set%nset, gto_basis_set%nsgf
2056 WRITE (unit=output_unit, fmt="(/,T6,6A12)") gto_basis_set%cgf_symbol
2057 WRITE (unit=output_unit, fmt="(/,T6,6A12)") gto_basis_set%sgf_symbol
2058 WRITE (unit=output_unit, fmt="(/,T6,6F12.6)") gto_basis_set%norm_cgf
2059 WRITE (unit=output_unit, fmt="(/,T6,6F12.6)") gto_basis_set%set_radius
2060 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lmax
2061 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lmin
2062 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lx
2063 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%ly
2064 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%lz
2065 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%m
2066 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%ncgf_set
2067 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%nsgf_set
2068 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%npgf
2069 WRITE (unit=output_unit, fmt="(/,T6,12I6)") gto_basis_set%nshell
2070
2071 DO iset = 1, gto_basis_set%nset
2072 WRITE (unit=output_unit, fmt="(T8,6F15.6)") &
2073 gto_basis_set%pgf_radius(1:gto_basis_set%npgf(iset), iset)
2074 END DO
2075
2076 DO iset = 1, gto_basis_set%nset
2077 WRITE (unit=output_unit, fmt="(T8,6F15.6)") &
2078 gto_basis_set%zet(1:gto_basis_set%npgf(iset), iset)
2079 END DO
2080
2081 DO iset = 1, gto_basis_set%nset
2082 DO ishell = 1, gto_basis_set%nshell(iset)
2083 WRITE (unit=output_unit, fmt="(T8,8I10)") &
2084 iset, ishell, &
2085 gto_basis_set%n(ishell, iset), &
2086 gto_basis_set%l(ishell, iset), &
2087 gto_basis_set%first_cgf(ishell, iset), &
2088 gto_basis_set%last_cgf(ishell, iset), &
2089 gto_basis_set%first_sgf(ishell, iset), &
2090 gto_basis_set%last_sgf(ishell, iset)
2091 END DO
2092 END DO
2093
2094 DO iset = 1, gto_basis_set%nset
2095 DO ishell = 1, gto_basis_set%nshell(iset)
2096 WRITE (unit=output_unit, fmt="(T8,2I5,(T25,4F15.6))") &
2097 iset, ishell, &
2098 (gto_basis_set%gcc(ipgf, ishell, iset), &
2099 ipgf=1, gto_basis_set%npgf(iset))
2100 END DO
2101 END DO
2102
2103 WRITE (unit=output_unit, fmt="(A5)") "CPHI"
2104 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%cphi
2105 WRITE (unit=output_unit, fmt="(A1)") "SPHI"
2106 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%sphi
2107 WRITE (unit=output_unit, fmt="(A1)") "SCON"
2108 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%scon
2109 WRITE (unit=output_unit, fmt="(A1)") "CCON"
2110 WRITE (unit=output_unit, fmt="(12F10.5)") gto_basis_set%ccon
2111
2112 END IF
2113
2114 END SUBROUTINE dump_gto_basis_set
2115
2116! **************************************************************************************************
2117!> \brief ...
2118!> \param sto_basis_set ...
2119! **************************************************************************************************
2120 SUBROUTINE allocate_sto_basis_set(sto_basis_set)
2121
2122 TYPE(sto_basis_set_type), POINTER :: sto_basis_set
2123
2124 CALL deallocate_sto_basis_set(sto_basis_set)
2125
2126 ALLOCATE (sto_basis_set)
2127
2128 END SUBROUTINE allocate_sto_basis_set
2129
2130! **************************************************************************************************
2131!> \brief ...
2132!> \param sto_basis_set ...
2133! **************************************************************************************************
2134 SUBROUTINE deallocate_sto_basis_set(sto_basis_set)
2135
2136 TYPE(sto_basis_set_type), POINTER :: sto_basis_set
2137
2138! -------------------------------------------------------------------------
2139
2140 IF (ASSOCIATED(sto_basis_set)) THEN
2141 IF (ASSOCIATED(sto_basis_set%symbol)) THEN
2142 DEALLOCATE (sto_basis_set%symbol)
2143 END IF
2144 IF (ASSOCIATED(sto_basis_set%nq)) THEN
2145 DEALLOCATE (sto_basis_set%nq)
2146 END IF
2147 IF (ASSOCIATED(sto_basis_set%lq)) THEN
2148 DEALLOCATE (sto_basis_set%lq)
2149 END IF
2150 IF (ASSOCIATED(sto_basis_set%zet)) THEN
2151 DEALLOCATE (sto_basis_set%zet)
2152 END IF
2153
2154 DEALLOCATE (sto_basis_set)
2155 END IF
2156 END SUBROUTINE deallocate_sto_basis_set
2157
2158! **************************************************************************************************
2159!> \brief ...
2160!> \param sto_basis_set ...
2161!> \param name ...
2162!> \param nshell ...
2163!> \param symbol ...
2164!> \param nq ...
2165!> \param lq ...
2166!> \param zet ...
2167!> \param maxlq ...
2168!> \param numsto ...
2169! **************************************************************************************************
2170 SUBROUTINE get_sto_basis_set(sto_basis_set, name, nshell, symbol, nq, lq, zet, maxlq, numsto)
2171
2172 TYPE(sto_basis_set_type), INTENT(IN) :: sto_basis_set
2173 CHARACTER(LEN=default_string_length), &
2174 INTENT(OUT), OPTIONAL :: name
2175 INTEGER, INTENT(OUT), OPTIONAL :: nshell
2176 CHARACTER(LEN=6), DIMENSION(:), OPTIONAL, POINTER :: symbol
2177 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nq, lq
2178 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: zet
2179 INTEGER, INTENT(OUT), OPTIONAL :: maxlq, numsto
2180
2181 INTEGER :: iset
2182
2183 IF (PRESENT(name)) name = sto_basis_set%name
2184 IF (PRESENT(nshell)) nshell = sto_basis_set%nshell
2185 IF (PRESENT(symbol)) symbol => sto_basis_set%symbol
2186 IF (PRESENT(nq)) nq => sto_basis_set%nq
2187 IF (PRESENT(lq)) lq => sto_basis_set%lq
2188 IF (PRESENT(zet)) zet => sto_basis_set%zet
2189 IF (PRESENT(maxlq)) THEN
2190 maxlq = maxval(sto_basis_set%lq(1:sto_basis_set%nshell))
2191 END IF
2192 IF (PRESENT(numsto)) THEN
2193 numsto = 0
2194 DO iset = 1, sto_basis_set%nshell
2195 numsto = numsto + 2*sto_basis_set%lq(iset) + 1
2196 END DO
2197 END IF
2198
2199 END SUBROUTINE get_sto_basis_set
2200
2201! **************************************************************************************************
2202!> \brief ...
2203!> \param sto_basis_set ...
2204!> \param name ...
2205!> \param nshell ...
2206!> \param symbol ...
2207!> \param nq ...
2208!> \param lq ...
2209!> \param zet ...
2210! **************************************************************************************************
2211 SUBROUTINE set_sto_basis_set(sto_basis_set, name, nshell, symbol, nq, lq, zet)
2212
2213 TYPE(sto_basis_set_type), INTENT(INOUT) :: sto_basis_set
2214 CHARACTER(LEN=default_string_length), INTENT(IN), &
2215 OPTIONAL :: name
2216 INTEGER, INTENT(IN), OPTIONAL :: nshell
2217 CHARACTER(LEN=6), DIMENSION(:), OPTIONAL, POINTER :: symbol
2218 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: nq, lq
2219 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: zet
2220
2221 INTEGER :: ns
2222
2223 IF (PRESENT(name)) sto_basis_set%name = name
2224 IF (PRESENT(nshell)) sto_basis_set%nshell = nshell
2225 IF (PRESENT(symbol)) THEN
2226 ns = SIZE(symbol)
2227 IF (ASSOCIATED(sto_basis_set%symbol)) DEALLOCATE (sto_basis_set%symbol)
2228 ALLOCATE (sto_basis_set%symbol(1:ns))
2229 sto_basis_set%symbol(:) = symbol(:)
2230 END IF
2231 IF (PRESENT(nq)) THEN
2232 ns = SIZE(nq)
2233 CALL reallocate(sto_basis_set%nq, 1, ns)
2234 sto_basis_set%nq = nq(:)
2235 END IF
2236 IF (PRESENT(lq)) THEN
2237 ns = SIZE(lq)
2238 CALL reallocate(sto_basis_set%lq, 1, ns)
2239 sto_basis_set%lq = lq(:)
2240 END IF
2241 IF (PRESENT(zet)) THEN
2242 ns = SIZE(zet)
2243 CALL reallocate(sto_basis_set%zet, 1, ns)
2244 sto_basis_set%zet = zet(:)
2245 END IF
2246
2247 END SUBROUTINE set_sto_basis_set
2248
2249! **************************************************************************************************
2250!> \brief ...
2251!> \param element_symbol ...
2252!> \param basis_set_name ...
2253!> \param sto_basis_set ...
2254!> \param para_env ...
2255!> \param dft_section ...
2256! **************************************************************************************************
2257 SUBROUTINE read_sto_basis_set(element_symbol, basis_set_name, sto_basis_set, para_env, dft_section)
2258
2259 ! Read a Slater-type orbital (STO) basis set from the database file.
2260
2261 CHARACTER(LEN=*), INTENT(IN) :: element_symbol, basis_set_name
2262 TYPE(sto_basis_set_type), INTENT(INOUT) :: sto_basis_set
2263 TYPE(mp_para_env_type), POINTER :: para_env
2264 TYPE(section_vals_type), POINTER :: dft_section
2265
2266 CHARACTER(LEN=10) :: nlsym
2267 CHARACTER(LEN=2) :: lsym
2268 CHARACTER(LEN=240) :: line
2269 CHARACTER(LEN=242) :: line2
2270 CHARACTER(len=default_path_length) :: basis_set_file_name, tmp
2271 CHARACTER(LEN=default_path_length), DIMENSION(:), &
2272 POINTER :: cbasis
2273 CHARACTER(LEN=LEN(basis_set_name)) :: bsname
2274 CHARACTER(LEN=LEN(basis_set_name)+2) :: bsname2
2275 CHARACTER(LEN=LEN(element_symbol)) :: symbol
2276 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
2277 INTEGER :: ibasis, irep, iset, nbasis, nq, nset, &
2278 strlen1, strlen2
2279 LOGICAL :: basis_found, found, match
2280 REAL(kind=dp) :: zet
2281 TYPE(cp_parser_type) :: parser
2282
2283 line = ""
2284 line2 = ""
2285 symbol = ""
2286 symbol2 = ""
2287 bsname = ""
2288 bsname2 = ""
2289
2290 nbasis = 1
2291
2292 sto_basis_set%name = basis_set_name
2293 CALL section_vals_val_get(dft_section, "BASIS_SET_FILE_NAME", &
2294 n_rep_val=nbasis)
2295 ALLOCATE (cbasis(nbasis))
2296 DO ibasis = 1, nbasis
2297 CALL section_vals_val_get(dft_section, "BASIS_SET_FILE_NAME", &
2298 i_rep_val=ibasis, c_val=cbasis(ibasis))
2299 basis_set_file_name = cbasis(ibasis)
2300 tmp = basis_set_file_name
2301 CALL uppercase(tmp)
2302 END DO
2303
2304 ! Search for the requested basis set in the basis set file
2305 ! until the basis set is found or the end of file is reached
2306
2307 basis_found = .false.
2308 basis_loop: DO ibasis = 1, nbasis
2309 IF (basis_found) EXIT basis_loop
2310 basis_set_file_name = cbasis(ibasis)
2311 CALL parser_create(parser, basis_set_file_name, para_env=para_env)
2312
2313 bsname = basis_set_name
2314 symbol = element_symbol
2315 irep = 0
2316
2317 tmp = basis_set_name
2318 CALL uppercase(tmp)
2319
2320 IF (tmp /= "NONE") THEN
2321 search_loop: DO
2322
2323 CALL parser_search_string(parser, trim(bsname), .true., found, line)
2324 IF (found) THEN
2325 CALL uppercase(symbol)
2326 CALL uppercase(bsname)
2327
2328 match = .false.
2329 CALL uppercase(line)
2330 ! Check both the element symbol and the basis set name
2331 line2 = " "//line//" "
2332 symbol2 = " "//trim(symbol)//" "
2333 bsname2 = " "//trim(bsname)//" "
2334 strlen1 = len_trim(symbol2) + 1
2335 strlen2 = len_trim(bsname2) + 1
2336
2337 IF ((index(line2, symbol2(:strlen1)) > 0) .AND. &
2338 (index(line2, bsname2(:strlen2)) > 0)) match = .true.
2339 IF (match) THEN
2340 ! Read the basis set information
2341 CALL parser_get_object(parser, nset, newline=.true.)
2342 sto_basis_set%nshell = nset
2343
2344 CALL reallocate(sto_basis_set%nq, 1, nset)
2345 CALL reallocate(sto_basis_set%lq, 1, nset)
2346 CALL reallocate(sto_basis_set%zet, 1, nset)
2347 ALLOCATE (sto_basis_set%symbol(nset))
2348
2349 DO iset = 1, nset
2350 CALL parser_get_object(parser, nq, newline=.true.)
2351 CALL parser_get_object(parser, lsym)
2352 CALL parser_get_object(parser, zet)
2353 sto_basis_set%nq(iset) = nq
2354 sto_basis_set%zet(iset) = zet
2355 WRITE (nlsym, "(I2,A)") nq, trim(lsym)
2356 sto_basis_set%symbol(iset) = trim(nlsym)
2357 SELECT CASE (trim(lsym))
2358 CASE ("S", "s")
2359 sto_basis_set%lq(iset) = 0
2360 CASE ("P", "p")
2361 sto_basis_set%lq(iset) = 1
2362 CASE ("D", "d")
2363 sto_basis_set%lq(iset) = 2
2364 CASE ("F", "f")
2365 sto_basis_set%lq(iset) = 3
2366 CASE ("G", "g")
2367 sto_basis_set%lq(iset) = 4
2368 CASE ("H", "h")
2369 sto_basis_set%lq(iset) = 5
2370 CASE ("I", "i", "J", "j")
2371 sto_basis_set%lq(iset) = 6
2372 CASE ("K", "k")
2373 sto_basis_set%lq(iset) = 7
2374 CASE ("L", "l")
2375 sto_basis_set%lq(iset) = 8
2376 CASE ("M", "m")
2377 sto_basis_set%lq(iset) = 9
2378 CASE DEFAULT
2379 CALL cp_abort(__location__, &
2380 "The requested basis set <"//trim(bsname)// &
2381 "> for element <"//trim(symbol)//"> has an invalid component: ")
2382 END SELECT
2383 END DO
2384
2385 basis_found = .true.
2386 EXIT search_loop
2387 END IF
2388 ELSE
2389 EXIT search_loop
2390 END IF
2391 END DO search_loop
2392 ELSE
2393 match = .false.
2394 END IF
2395
2396 CALL parser_release(parser)
2397
2398 END DO basis_loop
2399
2400 IF (tmp /= "NONE") THEN
2401 IF (.NOT. basis_found) THEN
2402 basis_set_file_name = ""
2403 DO ibasis = 1, nbasis
2404 basis_set_file_name = trim(basis_set_file_name)//"<"//trim(cbasis(ibasis))//"> "
2405 END DO
2406 CALL cp_abort(__location__, &
2407 "The requested basis set <"//trim(bsname)// &
2408 "> for element <"//trim(symbol)//"> was not "// &
2409 "found in the basis set files "// &
2410 trim(basis_set_file_name))
2411 END IF
2412 END IF
2413 DEALLOCATE (cbasis)
2414
2415 END SUBROUTINE read_sto_basis_set
2416
2417! **************************************************************************************************
2418!> \brief ...
2419!> \param sto_basis_set ...
2420!> \param gto_basis_set ...
2421!> \param ngauss ...
2422!> \param ortho ...
2423! **************************************************************************************************
2424 SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho)
2425
2426 TYPE(sto_basis_set_type), INTENT(IN) :: sto_basis_set
2427 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
2428 INTEGER, INTENT(IN), OPTIONAL :: ngauss
2429 LOGICAL, INTENT(IN), OPTIONAL :: ortho
2430
2431 INTEGER, PARAMETER :: maxng = 6
2432
2433 CHARACTER(LEN=default_string_length) :: name, sng
2434 INTEGER :: ipgf, iset, maxl, ng, nset, nshell
2435 INTEGER, DIMENSION(:), POINTER :: lq, nq
2436 LOGICAL :: do_ortho
2437 REAL(kind=dp), DIMENSION(:), POINTER :: zet
2438 REAL(kind=dp), DIMENSION(maxng) :: gcc, zetg
2439
2440 ng = 6
2441 IF (PRESENT(ngauss)) ng = ngauss
2442 IF (ng > maxng) cpabort("Too many Gaussian primitives requested")
2443 do_ortho = .false.
2444 IF (PRESENT(ortho)) do_ortho = ortho
2445
2446 CALL allocate_gto_basis_set(gto_basis_set)
2447
2448 CALL get_sto_basis_set(sto_basis_set, name=name, nshell=nshell, nq=nq, &
2449 lq=lq, zet=zet)
2450
2451 maxl = maxval(lq)
2452 CALL init_orbital_pointers(maxl)
2453
2454 CALL integer_to_string(ng, sng)
2455 gto_basis_set%name = trim(name)//"_STO-"//trim(sng)//"G"
2456
2457 nset = nshell
2458 gto_basis_set%nset = nset
2459 CALL reallocate(gto_basis_set%lmax, 1, nset)
2460 CALL reallocate(gto_basis_set%lmin, 1, nset)
2461 CALL reallocate(gto_basis_set%npgf, 1, nset)
2462 CALL reallocate(gto_basis_set%nshell, 1, nset)
2463 CALL reallocate(gto_basis_set%n, 1, 1, 1, nset)
2464 CALL reallocate(gto_basis_set%l, 1, 1, 1, nset)
2465 CALL reallocate(gto_basis_set%zet, 1, ng, 1, nset)
2466 CALL reallocate(gto_basis_set%gcc, 1, ng, 1, 1, 1, nset)
2467
2468 DO iset = 1, nset
2469 CALL get_sto_ng(zet(iset), ng, nq(iset), lq(iset), zetg, gcc)
2470 gto_basis_set%lmax(iset) = lq(iset)
2471 gto_basis_set%lmin(iset) = lq(iset)
2472 gto_basis_set%npgf(iset) = ng
2473 gto_basis_set%nshell(iset) = 1
2474 gto_basis_set%n(1, iset) = lq(iset) + 1
2475 gto_basis_set%l(1, iset) = lq(iset)
2476 DO ipgf = 1, ng
2477 gto_basis_set%gcc(ipgf, 1, iset) = gcc(ipgf)
2478 gto_basis_set%zet(ipgf, iset) = zetg(ipgf)
2479 END DO
2480 END DO
2481
2482 CALL process_gto_basis(gto_basis_set, do_ortho, nset, maxl)
2483
2484 END SUBROUTINE create_gto_from_sto_basis
2485
2486! **************************************************************************************************
2487!> \brief ...
2488!> \param gto_basis_set ...
2489!> \param do_ortho ...
2490!> \param nset ...
2491!> \param maxl ...
2492! **************************************************************************************************
2493 SUBROUTINE process_gto_basis(gto_basis_set, do_ortho, nset, maxl)
2494
2495 TYPE(gto_basis_set_type), POINTER :: gto_basis_set
2496 LOGICAL, INTENT(IN), OPTIONAL :: do_ortho
2497 INTEGER, INTENT(IN) :: nset, maxl
2498
2499 INTEGER :: i1, i2, ico, iset, jset, l, lshell, m, &
2500 maxco, ncgf, ng, ngs, np, nsgf
2501 INTEGER, DIMENSION(0:10) :: mxf
2502 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: gal, zal, zll
2503
2504 ng = gto_basis_set%npgf(1)
2505 DO iset = 1, nset
2506 IF ((ng /= gto_basis_set%npgf(iset)) .AND. do_ortho) &
2507 cpabort("different number of primitves")
2508 END DO
2509
2510 IF (do_ortho) THEN
2511 mxf = 0
2512 DO iset = 1, nset
2513 l = gto_basis_set%l(1, iset)
2514 mxf(l) = mxf(l) + 1
2515 END DO
2516 m = maxval(mxf)
2517 IF (m > 1) THEN
2518 ALLOCATE (gal(ng, nset), zal(ng, nset), zll(m*ng, 0:maxl))
2519 DO iset = 1, nset
2520 zal(1:ng, iset) = gto_basis_set%zet(1:ng, iset)
2521 gal(1:ng, iset) = gto_basis_set%gcc(1:ng, 1, iset)
2522 END DO
2523 CALL reallocate(gto_basis_set%zet, 1, m*ng, 1, nset)
2524 CALL reallocate(gto_basis_set%gcc, 1, m*ng, 1, 1, 1, nset)
2525 DO iset = 1, nset
2526 l = gto_basis_set%l(1, iset)
2527 gto_basis_set%npgf(iset) = ng*mxf(l)
2528 END DO
2529 gto_basis_set%zet = 0.0_dp
2530 gto_basis_set%gcc = 0.0_dp
2531 zll = 0.0_dp
2532 mxf = 0
2533 DO iset = 1, nset
2534 l = gto_basis_set%l(1, iset)
2535 mxf(l) = mxf(l) + 1
2536 i1 = mxf(l)*ng - ng + 1
2537 i2 = mxf(l)*ng
2538 zll(i1:i2, l) = zal(1:ng, iset)
2539 gto_basis_set%gcc(i1:i2, 1, iset) = gal(1:ng, iset)
2540 END DO
2541 DO iset = 1, nset
2542 l = gto_basis_set%l(1, iset)
2543 gto_basis_set%zet(:, iset) = zll(:, l)
2544 END DO
2545 DO iset = 1, nset
2546 l = gto_basis_set%l(1, iset)
2547 DO jset = 1, iset - 1
2548 IF (gto_basis_set%l(1, iset) == l) THEN
2549 m = mxf(l)*ng
2550 CALL orthofun(gto_basis_set%zet(1:m, iset), gto_basis_set%gcc(1:m, 1, iset), &
2551 gto_basis_set%gcc(1:m, 1, jset), l)
2552 END IF
2553 END DO
2554 END DO
2555 DEALLOCATE (gal, zal, zll)
2556 END IF
2557 END IF
2558
2559 ngs = maxval(gto_basis_set%npgf(1:nset))
2560 CALL reallocate(gto_basis_set%set_radius, 1, nset)
2561 CALL reallocate(gto_basis_set%pgf_radius, 1, ngs, 1, nset)
2562 CALL reallocate(gto_basis_set%first_cgf, 1, 1, 1, nset)
2563 CALL reallocate(gto_basis_set%first_sgf, 1, 1, 1, nset)
2564 CALL reallocate(gto_basis_set%last_cgf, 1, 1, 1, nset)
2565 CALL reallocate(gto_basis_set%last_sgf, 1, 1, 1, nset)
2566 CALL reallocate(gto_basis_set%ncgf_set, 1, nset)
2567 CALL reallocate(gto_basis_set%nsgf_set, 1, nset)
2568
2569 maxco = 0
2570 ncgf = 0
2571 nsgf = 0
2572
2573 DO iset = 1, nset
2574 gto_basis_set%ncgf_set(iset) = 0
2575 gto_basis_set%nsgf_set(iset) = 0
2576 lshell = gto_basis_set%l(1, iset)
2577 gto_basis_set%first_cgf(1, iset) = ncgf + 1
2578 ncgf = ncgf + nco(lshell)
2579 gto_basis_set%last_cgf(1, iset) = ncgf
2580 gto_basis_set%ncgf_set(iset) = &
2581 gto_basis_set%ncgf_set(iset) + nco(lshell)
2582 gto_basis_set%first_sgf(1, iset) = nsgf + 1
2583 nsgf = nsgf + nso(lshell)
2584 gto_basis_set%last_sgf(1, iset) = nsgf
2585 gto_basis_set%nsgf_set(iset) = &
2586 gto_basis_set%nsgf_set(iset) + nso(lshell)
2587 ngs = gto_basis_set%npgf(iset)
2588 maxco = max(maxco, ngs*ncoset(lshell))
2589 END DO
2590
2591 gto_basis_set%ncgf = ncgf
2592 gto_basis_set%nsgf = nsgf
2593
2594 CALL reallocate(gto_basis_set%cphi, 1, maxco, 1, ncgf)
2595 CALL reallocate(gto_basis_set%sphi, 1, maxco, 1, nsgf)
2596 CALL reallocate(gto_basis_set%scon, 1, maxco, 1, nsgf)
2597 CALL reallocate(gto_basis_set%ccon, 1, maxco, 1, ncgf)
2598 CALL reallocate(gto_basis_set%lx, 1, ncgf)
2599 CALL reallocate(gto_basis_set%ly, 1, ncgf)
2600 CALL reallocate(gto_basis_set%lz, 1, ncgf)
2601 CALL reallocate(gto_basis_set%m, 1, nsgf)
2602 CALL reallocate(gto_basis_set%norm_cgf, 1, ncgf)
2603 ALLOCATE (gto_basis_set%cgf_symbol(ncgf))
2604 ALLOCATE (gto_basis_set%sgf_symbol(nsgf))
2605
2606 ncgf = 0
2607 nsgf = 0
2608
2609 DO iset = 1, nset
2610 lshell = gto_basis_set%l(1, iset)
2611 np = lshell + 1
2612 DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
2613 ncgf = ncgf + 1
2614 gto_basis_set%lx(ncgf) = indco(1, ico)
2615 gto_basis_set%ly(ncgf) = indco(2, ico)
2616 gto_basis_set%lz(ncgf) = indco(3, ico)
2617 gto_basis_set%cgf_symbol(ncgf) = &
2618 cgf_symbol(np, [gto_basis_set%lx(ncgf), &
2619 gto_basis_set%ly(ncgf), &
2620 gto_basis_set%lz(ncgf)])
2621 END DO
2622 DO m = -lshell, lshell
2623 nsgf = nsgf + 1
2624 gto_basis_set%m(nsgf) = m
2625 gto_basis_set%sgf_symbol(nsgf) = sgf_symbol(np, lshell, m)
2626 END DO
2627 END DO
2628
2629 gto_basis_set%norm_type = -1
2630
2631 END SUBROUTINE process_gto_basis
2632
2633! **************************************************************************************************
2634!> \brief ...
2635!> \param zet ...
2636!> \param co ...
2637!> \param cr ...
2638!> \param l ...
2639! **************************************************************************************************
2640 SUBROUTINE orthofun(zet, co, cr, l)
2641 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: zet
2642 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: co, cr
2643 INTEGER, INTENT(IN) :: l
2644
2645 REAL(kind=dp) :: ss
2646
2647 CALL aovlp(l, zet, cr, cr, ss)
2648 cr(:) = cr(:)/sqrt(ss)
2649 CALL aovlp(l, zet, co, cr, ss)
2650 co(:) = co(:) - ss*cr(:)
2651 CALL aovlp(l, zet, co, co, ss)
2652 co(:) = co(:)/sqrt(ss)
2653
2654 END SUBROUTINE orthofun
2655
2656! **************************************************************************************************
2657!> \brief ...
2658!> \param l ...
2659!> \param zet ...
2660!> \param ca ...
2661!> \param cb ...
2662!> \param ss ...
2663! **************************************************************************************************
2664 SUBROUTINE aovlp(l, zet, ca, cb, ss)
2665 INTEGER, INTENT(IN) :: l
2666 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: zet, ca, cb
2667 REAL(kind=dp), INTENT(OUT) :: ss
2668
2669 INTEGER :: i, j, m
2670 REAL(kind=dp) :: ab, ai, aj, s00, sss
2671
2672!
2673! use init_norm_cgf_orb
2674!
2675 m = SIZE(zet)
2676 ss = 0.0_dp
2677 DO i = 1, m
2678 ai = (2.0_dp*zet(i)/pi)**0.75_dp
2679 DO j = 1, m
2680 aj = (2.0_dp*zet(j)/pi)**0.75_dp
2681 ab = 1._dp/(zet(i) + zet(j))
2682 s00 = ai*aj*(pi*ab)**1.50_dp
2683 IF (l == 0) THEN
2684 sss = s00
2685 ELSEIF (l == 1) THEN
2686 sss = s00*ab*0.5_dp
2687 ELSE
2688 cpabort("aovlp lvalue")
2689 END IF
2690 ss = ss + sss*ca(i)*cb(j)
2691 END DO
2692 END DO
2693
2694 END SUBROUTINE aovlp
2695
2696! **************************************************************************************************
2697!> \brief ...
2698!> \param z ...
2699!> \param ne ...
2700!> \param n ...
2701!> \param l ...
2702!> \return ...
2703! **************************************************************************************************
2704 PURE FUNCTION srules(z, ne, n, l)
2705 ! Slater rules
2706 INTEGER, INTENT(IN) :: z
2707 INTEGER, DIMENSION(:, :), INTENT(IN) :: ne
2708 INTEGER, INTENT(IN) :: n, l
2709 REAL(dp) :: srules
2710
2711 REAL(dp), DIMENSION(7), PARAMETER :: &
2712 xns = [1.0_dp, 2.0_dp, 3.0_dp, 3.7_dp, 4.0_dp, 4.2_dp, 4.4_dp]
2713
2714 INTEGER :: i, l1, l2, m, m1, m2, nn
2715 REAL(dp) :: s
2716
2717 s = 0.0_dp
2718 ! The complete shell
2719 l1 = min(l + 1, 4)
2720 nn = min(n, 7)
2721 IF (l1 == 1) l2 = 2
2722 IF (l1 == 2) l2 = 1
2723 IF (l1 == 3) l2 = 4
2724 IF (l1 == 4) l2 = 3
2725 ! Rule a) no contribution from shells further out
2726 ! Rule b) 0.35 (1s 0.3) from each other electron in the same shell
2727 IF (n == 1) THEN
2728 m = ne(1, 1)
2729 s = s + 0.3_dp*real(m - 1, dp)
2730 ELSE
2731 m = ne(l1, nn) + ne(l2, nn)
2732 s = s + 0.35_dp*real(m - 1, dp)
2733 END IF
2734 ! Rule c) if (s,p) shell 0.85 from each electron with n-1, and 1.0
2735 ! from all electrons further in
2736 IF (l1 + l2 == 3) THEN
2737 IF (nn > 1) THEN
2738 m1 = ne(1, nn - 1) + ne(2, nn - 1) + ne(3, nn - 1) + ne(4, nn - 1)
2739 m2 = 0
2740 DO i = 1, nn - 2
2741 m2 = m2 + ne(1, i) + ne(2, i) + ne(3, i) + ne(4, i)
2742 END DO
2743 s = s + 0.85_dp*real(m1, dp) + 1._dp*real(m2, dp)
2744 END IF
2745 ELSE
2746 ! Rule d) if (d,f) shell 1.0 from each electron inside
2747 m = 0
2748 DO i = 1, nn - 1
2749 m = m + ne(1, i) + ne(2, i) + ne(3, i) + ne(4, i)
2750 END DO
2751 s = s + 1._dp*real(m, dp)
2752 END IF
2753 ! Slater exponent is (Z-S)/NS
2754 srules = (real(z, dp) - s)/xns(nn)
2755 END FUNCTION srules
2756
2757! **************************************************************************************************
2758!> \brief sort basis sets w.r.t. radius
2759!> \param basis_set ...
2760!> \param sort_method ...
2761! **************************************************************************************************
2762 SUBROUTINE sort_gto_basis_set(basis_set, sort_method)
2763 TYPE(gto_basis_set_type), INTENT(INOUT) :: basis_set
2764 INTEGER, INTENT(IN) :: sort_method
2765
2766 CHARACTER(LEN=12), DIMENSION(:), POINTER :: cgf_symbol
2767 CHARACTER(LEN=6), DIMENSION(:), POINTER :: sgf_symbol
2768 INTEGER :: ic, ic_max, icgf, icgf_new, icgf_old, ico, is, is_max, iset, isgf, isgf_new, &
2769 isgf_old, ishell, lshell, maxco, maxpgf, maxshell, mm, nc, ncgf, ns, nset
2770 INTEGER, ALLOCATABLE, DIMENSION(:) :: sort_index
2771 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: icgf_set, isgf_set
2772 INTEGER, DIMENSION(:), POINTER :: lx, ly, lz, m, npgf
2773 LOGICAL :: ccon_available
2774 REAL(dp), ALLOCATABLE, DIMENSION(:) :: tmp
2775 REAL(dp), DIMENSION(:), POINTER :: set_radius
2776 REAL(dp), DIMENSION(:, :), POINTER :: zet
2777 REAL(kind=dp), DIMENSION(:), POINTER :: norm_cgf
2778 REAL(kind=dp), DIMENSION(:, :), POINTER :: ccon, cphi, scon, sphi
2779
2780 NULLIFY (set_radius, zet)
2781
2782 IF (sort_method == basis_sort_default) RETURN
2783
2784 CALL get_gto_basis_set(gto_basis_set=basis_set, &
2785 nset=nset, &
2786 maxshell=maxshell, &
2787 maxpgf=maxpgf, &
2788 maxco=maxco, &
2789 ncgf=ncgf, &
2790 npgf=npgf, &
2791 set_radius=set_radius, &
2792 zet=zet)
2793
2794 ALLOCATE (sort_index(nset))
2795 ALLOCATE (tmp(nset))
2796 SELECT CASE (sort_method)
2797 CASE (basis_sort_zet)
2798 DO iset = 1, nset
2799 tmp(iset) = minval(basis_set%zet(:npgf(iset), iset))
2800 END DO
2801 CASE DEFAULT
2802 cpabort("Request basis sort criterion not implemented.")
2803 END SELECT
2804
2805 CALL sort(tmp(1:nset), nset, sort_index)
2806
2807 ic_max = 0
2808 is_max = 0
2809 DO iset = 1, nset
2810 ic = 0
2811 is = 0
2812 DO ishell = 1, basis_set%nshell(iset)
2813 DO ico = 1, nco(basis_set%l(ishell, iset))
2814 ic = ic + 1
2815 IF (ic > ic_max) ic_max = ic
2816 END DO
2817 lshell = basis_set%l(ishell, iset)
2818 DO mm = -lshell, lshell
2819 is = is + 1
2820 IF (is > is_max) is_max = is
2821 END DO
2822 END DO
2823 END DO
2824
2825 icgf = 0
2826 isgf = 0
2827 ALLOCATE (icgf_set(nset, ic_max))
2828 icgf_set(:, :) = 0
2829 ALLOCATE (isgf_set(nset, is_max))
2830 isgf_set(:, :) = 0
2831
2832 DO iset = 1, nset
2833 ic = 0
2834 is = 0
2835 DO ishell = 1, basis_set%nshell(iset)
2836 DO ico = 1, nco(basis_set%l(ishell, iset))
2837 icgf = icgf + 1
2838 ic = ic + 1
2839 icgf_set(iset, ic) = icgf
2840 END DO
2841 lshell = basis_set%l(ishell, iset)
2842 DO mm = -lshell, lshell
2843 isgf = isgf + 1
2844 is = is + 1
2845 isgf_set(iset, is) = isgf
2846 END DO
2847 END DO
2848 END DO
2849
2850 ALLOCATE (cgf_symbol(SIZE(basis_set%cgf_symbol)))
2851 ALLOCATE (norm_cgf(SIZE(basis_set%norm_cgf)))
2852 ALLOCATE (lx(SIZE(basis_set%lx)))
2853 ALLOCATE (ly(SIZE(basis_set%ly)))
2854 ALLOCATE (lz(SIZE(basis_set%lz)))
2855 ALLOCATE (cphi(SIZE(basis_set%cphi, 1), SIZE(basis_set%cphi, 2)))
2856 cphi = 0.0_dp
2857 ALLOCATE (sphi(SIZE(basis_set%sphi, 1), SIZE(basis_set%sphi, 2)))
2858 sphi = 0.0_dp
2859 ALLOCATE (scon(SIZE(basis_set%scon, 1), SIZE(basis_set%scon, 2)))
2860 scon = 0.0_dp
2861 ALLOCATE (ccon(SIZE(basis_set%cphi, 1), SIZE(basis_set%cphi, 2)))
2862 ccon = 0.0_dp
2863 ccon_available = ASSOCIATED(basis_set%ccon)
2864 IF (ccon_available) THEN
2865 ccon_available = (SIZE(basis_set%ccon, 1) == SIZE(ccon, 1)) .AND. &
2866 (SIZE(basis_set%ccon, 2) == SIZE(ccon, 2))
2867 END IF
2868
2869 ALLOCATE (sgf_symbol(SIZE(basis_set%sgf_symbol)))
2870 ALLOCATE (m(SIZE(basis_set%m)))
2871
2872 icgf_new = 0
2873 isgf_new = 0
2874 DO iset = 1, nset
2875 DO ic = 1, ic_max
2876 icgf_old = icgf_set(sort_index(iset), ic)
2877 IF (icgf_old == 0) cycle
2878 icgf_new = icgf_new + 1
2879 norm_cgf(icgf_new) = basis_set%norm_cgf(icgf_old)
2880 lx(icgf_new) = basis_set%lx(icgf_old)
2881 ly(icgf_new) = basis_set%ly(icgf_old)
2882 lz(icgf_new) = basis_set%lz(icgf_old)
2883 cphi(:, icgf_new) = basis_set%cphi(:, icgf_old)
2884 IF (ccon_available) ccon(:, icgf_new) = basis_set%ccon(:, icgf_old)
2885 cgf_symbol(icgf_new) = basis_set%cgf_symbol(icgf_old)
2886 END DO
2887 DO is = 1, is_max
2888 isgf_old = isgf_set(sort_index(iset), is)
2889 IF (isgf_old == 0) cycle
2890 isgf_new = isgf_new + 1
2891 m(isgf_new) = basis_set%m(isgf_old)
2892 sphi(:, isgf_new) = basis_set%sphi(:, isgf_old)
2893 scon(:, isgf_new) = basis_set%scon(:, isgf_old)
2894 sgf_symbol(isgf_new) = basis_set%sgf_symbol(isgf_old)
2895 END DO
2896 END DO
2897
2898 DEALLOCATE (basis_set%cgf_symbol)
2899 basis_set%cgf_symbol => cgf_symbol
2900 DEALLOCATE (basis_set%norm_cgf)
2901 basis_set%norm_cgf => norm_cgf
2902 DEALLOCATE (basis_set%lx)
2903 basis_set%lx => lx
2904 DEALLOCATE (basis_set%ly)
2905 basis_set%ly => ly
2906 DEALLOCATE (basis_set%lz)
2907 basis_set%lz => lz
2908 DEALLOCATE (basis_set%cphi)
2909 basis_set%cphi => cphi
2910 DEALLOCATE (basis_set%sphi)
2911 basis_set%sphi => sphi
2912 DEALLOCATE (basis_set%scon)
2913 basis_set%scon => scon
2914 IF (ASSOCIATED(basis_set%ccon)) DEALLOCATE (basis_set%ccon)
2915 basis_set%ccon => ccon
2916
2917 DEALLOCATE (basis_set%m)
2918 basis_set%m => m
2919 DEALLOCATE (basis_set%sgf_symbol)
2920 basis_set%sgf_symbol => sgf_symbol
2921
2922 basis_set%lmax = basis_set%lmax(sort_index)
2923 basis_set%lmin = basis_set%lmin(sort_index)
2924 basis_set%npgf = basis_set%npgf(sort_index)
2925 basis_set%nshell = basis_set%nshell(sort_index)
2926 basis_set%ncgf_set = basis_set%ncgf_set(sort_index)
2927 basis_set%nsgf_set = basis_set%nsgf_set(sort_index)
2928
2929 basis_set%n(:, :) = basis_set%n(:, sort_index)
2930 basis_set%l(:, :) = basis_set%l(:, sort_index)
2931 basis_set%zet(:, :) = basis_set%zet(:, sort_index)
2932
2933 basis_set%gcc(:, :, :) = basis_set%gcc(:, :, sort_index)
2934 basis_set%set_radius(:) = basis_set%set_radius(sort_index)
2935 basis_set%pgf_radius(:, :) = basis_set%pgf_radius(:, sort_index)
2936
2937 nc = 0
2938 ns = 0
2939 DO iset = 1, nset
2940 DO ishell = 1, basis_set%nshell(iset)
2941 lshell = basis_set%l(ishell, iset)
2942 basis_set%first_cgf(ishell, iset) = nc + 1
2943 nc = nc + nco(lshell)
2944 basis_set%last_cgf(ishell, iset) = nc
2945 basis_set%first_sgf(ishell, iset) = ns + 1
2946 ns = ns + nso(lshell)
2947 basis_set%last_sgf(ishell, iset) = ns
2948 END DO
2949 END DO
2950
2951 END SUBROUTINE sort_gto_basis_set
2952
2953END 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:2494
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:2705
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:1983
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:2763
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:1857
basis_set_types::deallocate_sto_basis_set
subroutine, public deallocate_sto_basis_set(sto_basis_set)
...
Definition basis_set_types.F:2135
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:1923
basis_set_types::allocate_sto_basis_set
subroutine, public allocate_sto_basis_set(sto_basis_set)
...
Definition basis_set_types.F:2121
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:2042
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:2425
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:2212
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:2258
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:786
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:1156
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:1047
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:743