(git:e68414f)
Loading...
Searching...
No Matches
atom_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Define the atom type and its sub types
10!> \author jgh
11!> \date 03.03.2008
12!> \version 1.0
13!>
14! **************************************************************************************************
16 USE atom_upf, ONLY: atom_read_upf,&
19 USE bessel_lib, ONLY: bessel0
20 USE bibliography, ONLY: limpanuparb2011,&
21 cite_reference
32 USE input_constants, ONLY: &
42 USE input_val_types, ONLY: val_get,&
44 USE kinds, ONLY: default_string_length,&
45 dp
46 USE mathconstants, ONLY: dfac,&
47 fac,&
48 pi,&
49 rootpi
51 ptable
56 USE string_utilities, ONLY: remove_word,&
58#include "./base/base_uses.f90"
59
60 IMPLICIT NONE
61
62 PRIVATE
63
64 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'atom_types'
65
66 ! maximum l-quantum number considered in atomic code/basis
67 INTEGER, PARAMETER :: lmat = 5
68
69 INTEGER, PARAMETER :: gto_basis = 100, &
70 cgto_basis = 101, &
71 sto_basis = 102, &
72 num_basis = 103
73
74 INTEGER, PARAMETER :: nmax = 25
75
76!> \brief Provides all information about a basis set
77! **************************************************************************************************
79 INTEGER :: basis_type = gto_basis
80 INTEGER, DIMENSION(0:lmat) :: nbas = 0
81 INTEGER, DIMENSION(0:lmat) :: nprim = 0
82 REAL(kind=dp), DIMENSION(:, :), POINTER :: am => null() !GTO exponents
83 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: cm => null() !Contraction coeffs
84 REAL(kind=dp), DIMENSION(:, :), POINTER :: as => null() !STO exponents
85 INTEGER, DIMENSION(:, :), POINTER :: ns => null() !STO n-quantum numbers
86 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: bf => null() !num. bsf
87 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: dbf => null() !derivatives (num)
88 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: ddbf => null() !2nd derivatives (num)
89 REAL(kind=dp) :: eps_eig = 0.0_dp
90 TYPE(grid_atom_type), POINTER :: grid => null()
91 LOGICAL :: geometrical = .false.
92 REAL(kind=dp) :: aval = 0.0_dp, cval = 0.0_dp
93 INTEGER, DIMENSION(0:lmat) :: start = 0
94 END TYPE atom_basis_type
95
96!> \brief Provides all information about a pseudopotential
97! **************************************************************************************************
99 CHARACTER(LEN=2) :: symbol = ""
100 CHARACTER(LEN=default_string_length) :: pname = ""
101 INTEGER, DIMENSION(0:lmat) :: econf = 0
102 REAL(dp) :: zion = 0.0_dp
103 REAL(dp) :: rc = 0.0_dp
104 INTEGER :: ncl = 0
105 REAL(dp), DIMENSION(5) :: cl = 0.0_dp
106 INTEGER, DIMENSION(0:lmat) :: nl = 0
107 REAL(dp), DIMENSION(0:lmat) :: rcnl = 0.0_dp
108 REAL(dp), DIMENSION(4, 4, 0:lmat) :: hnl = 0.0_dp
109 ! SOC
110 LOGICAL :: soc = .false.
111 REAL(dp), DIMENSION(4, 4, 0:lmat) :: knl = 0.0_dp
112 ! type extensions
113 ! NLCC
114 LOGICAL :: nlcc = .false.
115 INTEGER :: nexp_nlcc = 0
116 REAL(kind=dp), DIMENSION(10) :: alpha_nlcc = 0.0_dp
117 INTEGER, DIMENSION(10) :: nct_nlcc = 0
118 REAL(kind=dp), DIMENSION(4, 10) :: cval_nlcc = 0.0_dp
119 ! LSD potential
120 LOGICAL :: lsdpot = .false.
121 INTEGER :: nexp_lsd = 0
122 REAL(kind=dp), DIMENSION(10) :: alpha_lsd = 0.0_dp
123 INTEGER, DIMENSION(10) :: nct_lsd = 0
124 REAL(kind=dp), DIMENSION(4, 10) :: cval_lsd = 0.0_dp
125 ! extended local potential
126 LOGICAL :: lpotextended = .false.
127 INTEGER :: nexp_lpot = 0
128 REAL(kind=dp), DIMENSION(10) :: alpha_lpot = 0.0_dp
129 INTEGER, DIMENSION(10) :: nct_lpot = 0
130 REAL(kind=dp), DIMENSION(4, 10) :: cval_lpot = 0.0_dp
131 END TYPE atom_gthpot_type
132
134 CHARACTER(LEN=2) :: symbol = ""
135 CHARACTER(LEN=default_string_length) :: pname = ""
136 INTEGER, DIMENSION(0:lmat) :: econf = 0
137 REAL(dp) :: zion = 0.0_dp
138 INTEGER :: lmax = 0
139 INTEGER :: nloc = 0 ! # terms
140 INTEGER, DIMENSION(1:15) :: nrloc = 0 ! r**(n-2)
141 REAL(dp), DIMENSION(1:15) :: aloc = 0.0_dp ! coefficient
142 REAL(dp), DIMENSION(1:15) :: bloc = 0.0_dp ! exponent
143 INTEGER, DIMENSION(0:10) :: npot = 0 ! # terms
144 INTEGER, DIMENSION(1:15, 0:10) :: nrpot = 0 ! r**(n-2)
145 REAL(dp), DIMENSION(1:15, 0:10) :: apot = 0.0_dp ! coefficient
146 REAL(dp), DIMENSION(1:15, 0:10) :: bpot = 0.0_dp ! exponent
147 END TYPE atom_ecppot_type
148
150 CHARACTER(LEN=2) :: symbol = ""
151 CHARACTER(LEN=default_string_length) :: pname = ""
152 INTEGER, DIMENSION(0:lmat) :: econf = 0
153 REAL(dp) :: zion = 0.0_dp
154 INTEGER :: lmax = 0
155 LOGICAL :: has_nonlocal = .false.
156 INTEGER :: n_nonlocal = 0
157 LOGICAL, DIMENSION(0:5) :: is_nonlocal = .false.
158 REAL(kind=dp), DIMENSION(nmax) :: a_nonlocal = 0.0_dp
159 REAL(kind=dp), DIMENSION(nmax, 0:lmat) :: h_nonlocal = 0.0_dp
160 REAL(kind=dp), DIMENSION(nmax, nmax, 0:lmat) :: c_nonlocal = 0.0_dp
161 INTEGER :: n_local = 0
162 REAL(kind=dp) :: ac_local = 0.0_dp
163 REAL(kind=dp), DIMENSION(nmax) :: a_local = 0.0_dp
164 REAL(kind=dp), DIMENSION(nmax) :: c_local = 0.0_dp
165 LOGICAL :: has_nlcc = .false.
166 INTEGER :: n_nlcc = 0
167 REAL(kind=dp), DIMENSION(nmax) :: a_nlcc = 0.0_dp
168 REAL(kind=dp), DIMENSION(nmax) :: c_nlcc = 0.0_dp
169 END TYPE atom_sgppot_type
170
172 INTEGER :: ppot_type = 0
173 LOGICAL :: confinement = .false.
174 INTEGER :: conf_type = 0
175 REAL(dp) :: acon = 0.0_dp
176 REAL(dp) :: rcon = 0.0_dp
177 REAL(dp) :: scon = 0.0_dp
182 END TYPE atom_potential_type
183
184!> \brief Provides info about hartree-fock exchange (For now, we only support potentials that can be represented
185!> with Coulomb and longrange-coulomb potential)
186! **************************************************************************************************
188 REAL(kind=dp) :: scale_coulomb = 0.0_dp
189 REAL(kind=dp) :: scale_longrange = 0.0_dp
190 REAL(kind=dp) :: omega = 0.0_dp
191 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: kernel
192 LOGICAL :: do_gh = .false.
193 INTEGER :: nr_gh = 0
194 END TYPE atom_hfx_type
195
196!> \brief Provides all information on states and occupation
197! **************************************************************************************************
199 REAL(kind=dp), DIMENSION(0:lmat, 10) :: occ = 0.0_dp
200 REAL(kind=dp), DIMENSION(0:lmat, 10) :: core = 0.0_dp
201 REAL(kind=dp), DIMENSION(0:lmat, 10) :: occupation = 0.0_dp
202 INTEGER :: maxl_occ = 0
203 INTEGER, DIMENSION(0:lmat) :: maxn_occ = 0
204 INTEGER :: maxl_calc = 0
205 INTEGER, DIMENSION(0:lmat) :: maxn_calc = 0
206 INTEGER :: multiplicity = 0
207 REAL(kind=dp), DIMENSION(0:lmat, 10) :: occa = 0.0_dp, occb = 0.0_dp
208 END TYPE atom_state
209
210!> \brief Holds atomic integrals
211! **************************************************************************************************
212 TYPE eri
213 REAL(kind=dp), DIMENSION(:, :), POINTER :: int => null()
214 END TYPE eri
215
217 INTEGER :: status = 0
218 INTEGER :: ppstat = 0
219 LOGICAL :: eri_coulomb = .false.
220 LOGICAL :: eri_exchange = .false.
221 LOGICAL :: all_nu = .false.
222 INTEGER, DIMENSION(0:lmat) :: n = 0, nne = 0
223 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: ovlp => null(), kin => null(), core => null(), clsd => null()
224 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: utrans => null(), uptrans => null()
225 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: hnl => null()
226 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: conf => null()
227 TYPE(eri), DIMENSION(100) :: ceri = eri()
228 TYPE(eri), DIMENSION(100) :: eeri = eri()
229 INTEGER :: dkhstat = 0
230 INTEGER :: zorastat = 0
231 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: tzora => null()
232 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: hdkh => null()
233 END TYPE atom_integrals
234
235!> \brief Holds atomic orbitals and energies
236! **************************************************************************************************
238 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: wfn => null(), wfna => null(), wfnb => null()
239 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: pmat => null(), pmata => null(), pmatb => null()
240 REAL(kind=dp), DIMENSION(:, :), POINTER :: ener => null(), enera => null(), enerb => null()
241 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: refene => null(), refchg => null(), refnod => null()
242 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: wrefene => null(), wrefchg => null(), wrefnod => null()
243 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: crefene => null(), crefchg => null(), crefnod => null()
244 REAL(kind=dp), DIMENSION(:, :), POINTER :: wpsir0 => null(), tpsir0 => null()
245 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: rcmax => null()
246 CHARACTER(LEN=2), DIMENSION(:, :, :), POINTER :: reftype => null()
247 END TYPE atom_orbitals
248
249!> \brief Operator matrices
250! **************************************************************************************************
252 INTEGER, DIMENSION(0:lmat) :: n = 0
253 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: op => null()
254 END TYPE opmat_type
255
256!> \brief Operator grids
257! **************************************************************************************************
259 REAL(kind=dp), DIMENSION(:), POINTER :: op => null()
260 TYPE(grid_atom_type), POINTER :: grid => null()
261 END TYPE opgrid_type
262
263!> \brief All energies
264! **************************************************************************************************
265 TYPE atom_energy_type
266 REAL(kind=dp) :: etot = 0.0_dp
267 REAL(kind=dp) :: eband = 0.0_dp
268 REAL(kind=dp) :: ekin = 0.0_dp
269 REAL(kind=dp) :: epot = 0.0_dp
270 REAL(kind=dp) :: ecore = 0.0_dp
271 REAL(kind=dp) :: elsd = 0.0_dp
272 REAL(kind=dp) :: epseudo = 0.0_dp
273 REAL(kind=dp) :: eploc = 0.0_dp
274 REAL(kind=dp) :: epnl = 0.0_dp
275 REAL(kind=dp) :: exc = 0.0_dp
276 REAL(kind=dp) :: ecoulomb = 0.0_dp
277 REAL(kind=dp) :: eexchange = 0.0_dp
278 REAL(kind=dp) :: econfinement = 0.0_dp
279 END TYPE atom_energy_type
280
281!> \brief Information on optimization procedure
282! **************************************************************************************************
284 REAL(kind=dp) :: damping = 0.0_dp
285 REAL(kind=dp) :: eps_scf = 0.0_dp
286 REAL(kind=dp) :: eps_diis = 0.0_dp
287 INTEGER :: max_iter = 0
288 INTEGER :: n_diis = 0
290
291!> \brief Provides all information about an atomic kind
292! **************************************************************************************************
294 INTEGER :: z = 0
295 INTEGER :: zcore = 0
296 LOGICAL :: pp_calc = .false.
297! ZMP adding in type some variables
298 LOGICAL :: do_zmp = .false., doread = .false., read_vxc = .false., dm = .false.
299 CHARACTER(LEN=default_string_length) :: ext_file = "", ext_vxc_file = "", &
300 zmp_restart_file = ""
301!
302 INTEGER :: method_type = do_rks_atom
303 INTEGER :: relativistic = do_nonrel_atom
304 INTEGER :: coulomb_integral_type = do_analytic
305 INTEGER :: exchange_integral_type = do_analytic
306! ZMP
307 REAL(kind=dp) :: lambda = 0.0_dp
308 REAL(kind=dp) :: rho_diff_integral = 0.0_dp
309 REAL(kind=dp) :: weight = 0.0_dp, zmpgrid_tol = 0.0_dp, zmpvxcgrid_tol = 0.0_dp
310!
311 TYPE(atom_basis_type), POINTER :: basis => null()
312 TYPE(atom_potential_type), POINTER :: potential => null()
313 TYPE(atom_state), POINTER :: state => null()
314 TYPE(atom_integrals), POINTER :: integrals => null()
315 TYPE(atom_orbitals), POINTER :: orbitals => null()
316 TYPE(atom_energy_type) :: energy = atom_energy_type()
318 TYPE(section_vals_type), POINTER :: xc_section => null(), zmp_section => null()
319 TYPE(opmat_type), POINTER :: fmat => null()
320 TYPE(atom_hfx_type) :: hfx_pot = atom_hfx_type()
321 END TYPE atom_type
322! **************************************************************************************************
324 TYPE(atom_type), POINTER :: atom => null()
325 END TYPE atom_p_type
326
327 PUBLIC :: lmat
331 PUBLIC :: atom_optimization_type
332 PUBLIC :: atom_compare_grids
338 PUBLIC :: clementi_geobas
343 PUBLIC :: setup_hf_section
344
345! **************************************************************************************************
346
347CONTAINS
348
349! **************************************************************************************************
350!> \brief Initialize the basis for the atomic code
351!> \param basis ...
352!> \param basis_section ...
353!> \param zval ...
354!> \param btyp ...
355!> \note Highly accurate relativistic universal Gaussian basis set: Dirac-Fock-Coulomb calculations
356!> for atomic systems up to nobelium
357!> J. Chem. Phys. 101, 6829 (1994); DOI:10.1063/1.468311
358!> G. L. Malli and A. B. F. Da Silva
359!> Department of Chemistry, Simon Fraser University, Burnaby, B.C., Canada
360!> Yasuyuki Ishikawa
361!> Department of Chemistry, University of Puerto Rico, San Juan, Puerto Rico
362!>
363!> A universal Gaussian basis set is developed that leads to relativistic Dirac-Fock SCF energies
364!> of comparable accuracy as that obtained by the accurate numerical finite-difference method
365!> (GRASP2 package) [J. Phys. B 25, 1 (1992)]. The Gaussian-type functions of our universal basis
366!> set satisfy the relativistic boundary conditions associated with the finite nuclear model for a
367!> finite speed of light and conform to the so-called kinetic balance at the nonrelativistic limit.
368!> We attribute the exceptionally high accuracy obtained in our calculations to the fact that the
369!> representation of the relativistic dynamics of an electron in a spherical ball finite nucleus
370!> near the origin in terms of our universal Gaussian basis set is as accurate as that provided by
371!> the numerical finite-difference method. Results of the Dirac-Fock-Coulomb energies for a number
372!> of atoms up to No (Z=102) and some negative ions are presented and compared with the recent
373!> results obtained with the numerical finite-difference method and geometrical Gaussian basis sets
374!> by Parpia, Mohanty, and Clementi [J. Phys. B 25, 1 (1992)]. The accuracy of our calculations is
375!> estimated to be within a few parts in 109 for all the atomic systems studied.
376! **************************************************************************************************
377 SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp)
378 TYPE(atom_basis_type), INTENT(INOUT) :: basis
379 TYPE(section_vals_type), POINTER :: basis_section
380 INTEGER, INTENT(IN) :: zval
381 CHARACTER(LEN=2) :: btyp
382
383 CHARACTER(LEN=*), PARAMETER :: routinen = 'init_atom_basis'
384 INTEGER, PARAMETER :: nua = 40, nup = 16
385 REAL(kind=dp), DIMENSION(nua), PARAMETER :: ugbs = (/0.007299_dp, 0.013705_dp, 0.025733_dp, &
386 0.048316_dp, 0.090718_dp, 0.170333_dp, 0.319819_dp, 0.600496_dp, 1.127497_dp, 2.117000_dp,&
387 3.974902_dp, 7.463317_dp, 14.013204_dp, 26.311339_dp, 49.402449_dp, 92.758561_dp, &
388 174.164456_dp, 327.013024_dp, 614.003114_dp, 1152.858743_dp, 2164.619772_dp, &
389 4064.312984_dp, 7631.197056_dp, 14328.416324_dp, 26903.186074_dp, 50513.706789_dp, &
390 94845.070265_dp, 178082.107320_dp, 334368.848683_dp, 627814.487663_dp, 1178791.123851_dp, &
391 2213310.684886_dp, 4155735.557141_dp, 7802853.046713_dp, 14650719.428954_dp, &
392 27508345.793637_dp, 51649961.080194_dp, 96978513.342764_dp, 182087882.613702_dp, &
393 341890134.751331_dp/)
394
395 CHARACTER(LEN=default_string_length) :: basis_fn, basis_name
396 INTEGER :: basistype, handle, i, j, k, l, ll, m, &
397 ngp, nl, nr, nu, quadtype
398 INTEGER, DIMENSION(0:lmat) :: starti
399 INTEGER, DIMENSION(:), POINTER :: nqm, num_gto, num_slater, sindex
400 REAL(kind=dp) :: al, amax, aval, cval, ear, pf, rk
401 REAL(kind=dp), DIMENSION(:), POINTER :: expo
402 TYPE(section_vals_type), POINTER :: gto_basis_section
403
404 CALL timeset(routinen, handle)
405
406 ! btyp = AE : standard all-electron basis
407 ! btyp = PP : standard pseudopotential basis
408 ! btyp = AA : high accuracy all-electron basis
409 ! btyp = AP : high accuracy pseudopotential basis
410
411 NULLIFY (basis%am, basis%cm, basis%as, basis%ns, basis%bf, basis%dbf, basis%ddbf)
412 ! get information on quadrature type and number of grid points
413 ! allocate and initialize the atomic grid
414 CALL allocate_grid_atom(basis%grid)
415 CALL section_vals_val_get(basis_section, "QUADRATURE", i_val=quadtype)
416 CALL section_vals_val_get(basis_section, "GRID_POINTS", i_val=ngp)
417 IF (ngp <= 0) &
418 cpabort("# point radial grid < 0")
419 CALL create_grid_atom(basis%grid, ngp, 1, 1, 0, quadtype)
420 basis%grid%nr = ngp
421 basis%geometrical = .false.
422 basis%aval = 0._dp
423 basis%cval = 0._dp
424 basis%start = 0
425
426 CALL section_vals_val_get(basis_section, "BASIS_TYPE", i_val=basistype)
427 CALL section_vals_val_get(basis_section, "EPS_EIGENVALUE", r_val=basis%eps_eig)
428 SELECT CASE (basistype)
429 CASE DEFAULT
430 cpabort("")
431 CASE (gaussian)
432 basis%basis_type = gto_basis
433 NULLIFY (num_gto)
434 CALL section_vals_val_get(basis_section, "NUM_GTO", i_vals=num_gto)
435 IF (num_gto(1) < 1) THEN
436 ! use default basis
437 IF (btyp == "AE") THEN
438 nu = nua
439 ELSEIF (btyp == "PP") THEN
440 nu = nup
441 ELSE
442 nu = nua
443 END IF
444 basis%nbas = nu
445 basis%nprim = nu
446 ALLOCATE (basis%am(nu, 0:lmat))
447 DO i = 0, lmat
448 basis%am(1:nu, i) = ugbs(1:nu)
449 END DO
450 ELSE
451 basis%nbas = 0
452 DO i = 1, SIZE(num_gto)
453 basis%nbas(i - 1) = num_gto(i)
454 END DO
455 basis%nprim = basis%nbas
456 m = maxval(basis%nbas)
457 ALLOCATE (basis%am(m, 0:lmat))
458 basis%am = 0._dp
459 DO l = 0, lmat
460 IF (basis%nbas(l) > 0) THEN
461 NULLIFY (expo)
462 SELECT CASE (l)
463 CASE DEFAULT
464 cpabort("Atom Basis")
465 CASE (0)
466 CALL section_vals_val_get(basis_section, "S_EXPONENTS", r_vals=expo)
467 CASE (1)
468 CALL section_vals_val_get(basis_section, "P_EXPONENTS", r_vals=expo)
469 CASE (2)
470 CALL section_vals_val_get(basis_section, "D_EXPONENTS", r_vals=expo)
471 CASE (3)
472 CALL section_vals_val_get(basis_section, "F_EXPONENTS", r_vals=expo)
473 END SELECT
474 cpassert(SIZE(expo) >= basis%nbas(l))
475 DO i = 1, basis%nbas(l)
476 basis%am(i, l) = expo(i)
477 END DO
478 END IF
479 END DO
480 END IF
481 ! initialize basis function on a radial grid
482 nr = basis%grid%nr
483 m = maxval(basis%nbas)
484 ALLOCATE (basis%bf(nr, m, 0:lmat))
485 ALLOCATE (basis%dbf(nr, m, 0:lmat))
486 ALLOCATE (basis%ddbf(nr, m, 0:lmat))
487 basis%bf = 0._dp
488 basis%dbf = 0._dp
489 basis%ddbf = 0._dp
490 DO l = 0, lmat
491 DO i = 1, basis%nbas(l)
492 al = basis%am(i, l)
493 DO k = 1, nr
494 rk = basis%grid%rad(k)
495 ear = exp(-al*basis%grid%rad(k)**2)
496 basis%bf(k, i, l) = rk**l*ear
497 basis%dbf(k, i, l) = (real(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear
498 basis%ddbf(k, i, l) = (real(l*(l - 1), dp)*rk**(l - 2) - &
499 2._dp*al*real(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear
500 END DO
501 END DO
502 END DO
503 CASE (geometrical_gto)
504 basis%basis_type = gto_basis
505 NULLIFY (num_gto)
506 CALL section_vals_val_get(basis_section, "NUM_GTO", i_vals=num_gto)
507 IF (num_gto(1) < 1) THEN
508 IF (btyp == "AE") THEN
509 ! use the Clementi extra large basis
510 CALL clementi_geobas(zval, cval, aval, basis%nbas, starti)
511 ELSEIF (btyp == "PP") THEN
512 ! use the Clementi extra large basis
513 CALL clementi_geobas(zval, cval, aval, basis%nbas, starti)
514 ELSEIF (btyp == "AA") THEN
515 CALL clementi_geobas(zval, cval, aval, basis%nbas, starti)
516 amax = cval**(basis%nbas(0) - 1)
517 basis%nbas(0) = nint((log(amax)/log(1.6_dp)))
518 cval = 1.6_dp
519 starti = 0
520 basis%nbas(1) = basis%nbas(0) - 4
521 basis%nbas(2) = basis%nbas(0) - 8
522 basis%nbas(3) = basis%nbas(0) - 12
523 IF (lmat > 3) basis%nbas(4:lmat) = 0
524 ELSEIF (btyp == "AP") THEN
525 CALL clementi_geobas(zval, cval, aval, basis%nbas, starti)
526 amax = 500._dp/aval
527 basis%nbas = nint((log(amax)/log(1.6_dp)))
528 cval = 1.6_dp
529 starti = 0
530 ELSE
531 ! use the Clementi extra large basis
532 CALL clementi_geobas(zval, cval, aval, basis%nbas, starti)
533 END IF
534 basis%nprim = basis%nbas
535 ELSE
536 basis%nbas = 0
537 DO i = 1, SIZE(num_gto)
538 basis%nbas(i - 1) = num_gto(i)
539 END DO
540 basis%nprim = basis%nbas
541 NULLIFY (sindex)
542 CALL section_vals_val_get(basis_section, "START_INDEX", i_vals=sindex)
543 starti = 0
544 DO i = 1, SIZE(sindex)
545 starti(i - 1) = sindex(i)
546 cpassert(sindex(i) >= 0)
547 END DO
548 CALL section_vals_val_get(basis_section, "GEOMETRICAL_FACTOR", r_val=cval)
549 CALL section_vals_val_get(basis_section, "GEO_START_VALUE", r_val=aval)
550 END IF
551 m = maxval(basis%nbas)
552 ALLOCATE (basis%am(m, 0:lmat))
553 basis%am = 0._dp
554 DO l = 0, lmat
555 DO i = 1, basis%nbas(l)
556 ll = i - 1 + starti(l)
557 basis%am(i, l) = aval*cval**(ll)
558 END DO
559 END DO
560
561 basis%geometrical = .true.
562 basis%aval = aval
563 basis%cval = cval
564 basis%start = starti
565
566 ! initialize basis function on a radial grid
567 nr = basis%grid%nr
568 m = maxval(basis%nbas)
569 ALLOCATE (basis%bf(nr, m, 0:lmat))
570 ALLOCATE (basis%dbf(nr, m, 0:lmat))
571 ALLOCATE (basis%ddbf(nr, m, 0:lmat))
572 basis%bf = 0._dp
573 basis%dbf = 0._dp
574 basis%ddbf = 0._dp
575 DO l = 0, lmat
576 DO i = 1, basis%nbas(l)
577 al = basis%am(i, l)
578 DO k = 1, nr
579 rk = basis%grid%rad(k)
580 ear = exp(-al*basis%grid%rad(k)**2)
581 basis%bf(k, i, l) = rk**l*ear
582 basis%dbf(k, i, l) = (real(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear
583 basis%ddbf(k, i, l) = (real(l*(l - 1), dp)*rk**(l - 2) - &
584 2._dp*al*real(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear
585 END DO
586 END DO
587 END DO
588 CASE (contracted_gto)
589 basis%basis_type = cgto_basis
590 CALL section_vals_val_get(basis_section, "BASIS_SET_FILE_NAME", c_val=basis_fn)
591 CALL section_vals_val_get(basis_section, "BASIS_SET", c_val=basis_name)
592 gto_basis_section => section_vals_get_subs_vals(basis_section, "BASIS")
593 CALL read_basis_set(ptable(zval)%symbol, basis, basis_name, basis_fn, &
594 gto_basis_section)
595
596 ! initialize basis function on a radial grid
597 nr = basis%grid%nr
598 m = maxval(basis%nbas)
599 ALLOCATE (basis%bf(nr, m, 0:lmat))
600 ALLOCATE (basis%dbf(nr, m, 0:lmat))
601 ALLOCATE (basis%ddbf(nr, m, 0:lmat))
602 basis%bf = 0._dp
603 basis%dbf = 0._dp
604 basis%ddbf = 0._dp
605 DO l = 0, lmat
606 DO i = 1, basis%nprim(l)
607 al = basis%am(i, l)
608 DO k = 1, nr
609 rk = basis%grid%rad(k)
610 ear = exp(-al*basis%grid%rad(k)**2)
611 DO j = 1, basis%nbas(l)
612 basis%bf(k, j, l) = basis%bf(k, j, l) + rk**l*ear*basis%cm(i, j, l)
613 basis%dbf(k, j, l) = basis%dbf(k, j, l) &
614 + (real(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*basis%cm(i, j, l)
615 basis%ddbf(k, j, l) = basis%ddbf(k, j, l) + &
616 (real(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*real(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))* &
617 ear*basis%cm(i, j, l)
618 END DO
619 END DO
620 END DO
621 END DO
622 CASE (slater)
623 basis%basis_type = sto_basis
624 NULLIFY (num_slater)
625 CALL section_vals_val_get(basis_section, "NUM_SLATER", i_vals=num_slater)
626 IF (num_slater(1) < 1) THEN
627 cpabort("")
628 ELSE
629 basis%nbas = 0
630 DO i = 1, SIZE(num_slater)
631 basis%nbas(i - 1) = num_slater(i)
632 END DO
633 basis%nprim = basis%nbas
634 m = maxval(basis%nbas)
635 ALLOCATE (basis%as(m, 0:lmat), basis%ns(m, 0:lmat))
636 basis%as = 0._dp
637 basis%ns = 0
638 DO l = 0, lmat
639 IF (basis%nbas(l) > 0) THEN
640 NULLIFY (expo)
641 SELECT CASE (l)
642 CASE DEFAULT
643 cpabort("Atom Basis")
644 CASE (0)
645 CALL section_vals_val_get(basis_section, "S_EXPONENTS", r_vals=expo)
646 CASE (1)
647 CALL section_vals_val_get(basis_section, "P_EXPONENTS", r_vals=expo)
648 CASE (2)
649 CALL section_vals_val_get(basis_section, "D_EXPONENTS", r_vals=expo)
650 CASE (3)
651 CALL section_vals_val_get(basis_section, "F_EXPONENTS", r_vals=expo)
652 END SELECT
653 cpassert(SIZE(expo) >= basis%nbas(l))
654 DO i = 1, basis%nbas(l)
655 basis%as(i, l) = expo(i)
656 END DO
657 NULLIFY (nqm)
658 SELECT CASE (l)
659 CASE DEFAULT
660 cpabort("Atom Basis")
661 CASE (0)
662 CALL section_vals_val_get(basis_section, "S_QUANTUM_NUMBERS", i_vals=nqm)
663 CASE (1)
664 CALL section_vals_val_get(basis_section, "P_QUANTUM_NUMBERS", i_vals=nqm)
665 CASE (2)
666 CALL section_vals_val_get(basis_section, "D_QUANTUM_NUMBERS", i_vals=nqm)
667 CASE (3)
668 CALL section_vals_val_get(basis_section, "F_QUANTUM_NUMBERS", i_vals=nqm)
669 END SELECT
670 cpassert(SIZE(nqm) >= basis%nbas(l))
671 DO i = 1, basis%nbas(l)
672 basis%ns(i, l) = nqm(i)
673 END DO
674 END IF
675 END DO
676 END IF
677 ! initialize basis function on a radial grid
678 nr = basis%grid%nr
679 m = maxval(basis%nbas)
680 ALLOCATE (basis%bf(nr, m, 0:lmat))
681 ALLOCATE (basis%dbf(nr, m, 0:lmat))
682 ALLOCATE (basis%ddbf(nr, m, 0:lmat))
683 basis%bf = 0._dp
684 basis%dbf = 0._dp
685 basis%ddbf = 0._dp
686 DO l = 0, lmat
687 DO i = 1, basis%nbas(l)
688 al = basis%as(i, l)
689 nl = basis%ns(i, l)
690 pf = (2._dp*al)**nl*sqrt(2._dp*al/fac(2*nl))
691 DO k = 1, nr
692 rk = basis%grid%rad(k)
693 ear = rk**(nl - 1)*exp(-al*rk)
694 basis%bf(k, i, l) = pf*ear
695 basis%dbf(k, i, l) = pf*(real(nl - 1, dp)/rk - al)*ear
696 basis%ddbf(k, i, l) = pf*(real((nl - 2)*(nl - 1), dp)/rk/rk &
697 - al*real(2*(nl - 1), dp)/rk + al*al)*ear
698 END DO
699 END DO
700 END DO
701 CASE (numerical)
702 basis%basis_type = num_basis
703 cpabort("")
704 END SELECT
705
706 CALL timestop(handle)
707
708 END SUBROUTINE init_atom_basis
709
710! **************************************************************************************************
711!> \brief ...
712!> \param basis ...
713! **************************************************************************************************
715 TYPE(atom_basis_type), INTENT(INOUT) :: basis
716
717 CHARACTER(LEN=*), PARAMETER :: routinen = 'init_atom_basis_default_pp'
718 INTEGER, PARAMETER :: nua = 40, nup = 20
719 REAL(kind=dp), DIMENSION(nua), PARAMETER :: ugbs = (/0.007299_dp, 0.013705_dp, 0.025733_dp, &
720 0.048316_dp, 0.090718_dp, 0.170333_dp, 0.319819_dp, 0.600496_dp, 1.127497_dp, 2.117000_dp,&
721 3.974902_dp, 7.463317_dp, 14.013204_dp, 26.311339_dp, 49.402449_dp, 92.758561_dp, &
722 174.164456_dp, 327.013024_dp, 614.003114_dp, 1152.858743_dp, 2164.619772_dp, &
723 4064.312984_dp, 7631.197056_dp, 14328.416324_dp, 26903.186074_dp, 50513.706789_dp, &
724 94845.070265_dp, 178082.107320_dp, 334368.848683_dp, 627814.487663_dp, 1178791.123851_dp, &
725 2213310.684886_dp, 4155735.557141_dp, 7802853.046713_dp, 14650719.428954_dp, &
726 27508345.793637_dp, 51649961.080194_dp, 96978513.342764_dp, 182087882.613702_dp, &
727 341890134.751331_dp/)
728
729 INTEGER :: handle, i, k, l, m, ngp, nr, nu, quadtype
730 REAL(kind=dp) :: al, ear, rk
731
732 CALL timeset(routinen, handle)
733
734 NULLIFY (basis%am, basis%cm, basis%as, basis%ns, basis%bf, basis%dbf, basis%ddbf)
735
736 ! Allocate and initialize the atomic grid
737 NULLIFY (basis%grid)
738 CALL allocate_grid_atom(basis%grid)
739 quadtype = do_gapw_log
740 ngp = 500
741 CALL create_grid_atom(basis%grid, ngp, 1, 1, 0, quadtype)
742 basis%grid%nr = ngp
743 basis%geometrical = .false.
744 basis%aval = 0._dp
745 basis%cval = 0._dp
746 basis%start = 0
747 basis%eps_eig = 1.e-12_dp
748
749 basis%basis_type = gto_basis
750 nu = nup
751 basis%nbas = nu
752 basis%nprim = nu
753 ALLOCATE (basis%am(nu, 0:lmat))
754 DO i = 0, lmat
755 basis%am(1:nu, i) = ugbs(1:nu)
756 END DO
757 ! initialize basis function on a radial grid
758 nr = basis%grid%nr
759 m = maxval(basis%nbas)
760 ALLOCATE (basis%bf(nr, m, 0:lmat))
761 ALLOCATE (basis%dbf(nr, m, 0:lmat))
762 ALLOCATE (basis%ddbf(nr, m, 0:lmat))
763 basis%bf = 0._dp
764 basis%dbf = 0._dp
765 basis%ddbf = 0._dp
766 DO l = 0, lmat
767 DO i = 1, basis%nbas(l)
768 al = basis%am(i, l)
769 DO k = 1, nr
770 rk = basis%grid%rad(k)
771 ear = exp(-al*basis%grid%rad(k)**2)
772 basis%bf(k, i, l) = rk**l*ear
773 basis%dbf(k, i, l) = (real(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear
774 basis%ddbf(k, i, l) = (real(l*(l - 1), dp)*rk**(l - 2) - &
775 2._dp*al*real(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear
776 END DO
777 END DO
778 END DO
779
780 CALL timestop(handle)
781
782 END SUBROUTINE init_atom_basis_default_pp
783
784! **************************************************************************************************
785!> \brief ...
786!> \param basis ...
787!> \param gbasis ...
788!> \param r ...
789!> \param rab ...
790! **************************************************************************************************
791 SUBROUTINE atom_basis_gridrep(basis, gbasis, r, rab)
792 TYPE(atom_basis_type), INTENT(IN) :: basis
793 TYPE(atom_basis_type), INTENT(INOUT) :: gbasis
794 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: r, rab
795
796 INTEGER :: i, j, k, l, m, n1, n2, n3, ngp, nl, nr, &
797 quadtype
798 REAL(kind=dp) :: al, ear, pf, rk
799
800 NULLIFY (gbasis%am, gbasis%cm, gbasis%as, gbasis%ns, gbasis%bf, gbasis%dbf, gbasis%ddbf)
801
802 ! copy basis info
803 gbasis%basis_type = basis%basis_type
804 gbasis%nbas(0:lmat) = basis%nbas(0:lmat)
805 gbasis%nprim(0:lmat) = basis%nprim(0:lmat)
806 IF (ASSOCIATED(basis%am)) THEN
807 n1 = SIZE(basis%am, 1)
808 n2 = SIZE(basis%am, 2)
809 ALLOCATE (gbasis%am(n1, 0:n2 - 1))
810 gbasis%am = basis%am
811 END IF
812 IF (ASSOCIATED(basis%cm)) THEN
813 n1 = SIZE(basis%cm, 1)
814 n2 = SIZE(basis%cm, 2)
815 n3 = SIZE(basis%cm, 3)
816 ALLOCATE (gbasis%cm(n1, n2, 0:n3 - 1))
817 gbasis%cm = basis%cm
818 END IF
819 IF (ASSOCIATED(basis%as)) THEN
820 n1 = SIZE(basis%as, 1)
821 n2 = SIZE(basis%as, 2)
822 ALLOCATE (gbasis%as(n1, 0:n2 - 1))
823 gbasis%as = basis%as
824 END IF
825 IF (ASSOCIATED(basis%ns)) THEN
826 n1 = SIZE(basis%ns, 1)
827 n2 = SIZE(basis%ns, 2)
828 ALLOCATE (gbasis%ns(n1, 0:n2 - 1))
829 gbasis%ns = basis%ns
830 END IF
831 gbasis%eps_eig = basis%eps_eig
832 gbasis%geometrical = basis%geometrical
833 gbasis%aval = basis%aval
834 gbasis%cval = basis%cval
835 gbasis%start(0:lmat) = basis%start(0:lmat)
836
837 ! get information on quadrature type and number of grid points
838 ! allocate and initialize the atomic grid
839 NULLIFY (gbasis%grid)
840 CALL allocate_grid_atom(gbasis%grid)
841 ngp = SIZE(r)
842 quadtype = do_gapw_log
843 IF (ngp <= 0) &
844 cpabort("# point radial grid < 0")
845 CALL create_grid_atom(gbasis%grid, ngp, 1, 1, 0, quadtype)
846 gbasis%grid%nr = ngp
847 gbasis%grid%rad(:) = r(:)
848 gbasis%grid%rad2(:) = r(:)*r(:)
849 gbasis%grid%wr(:) = rab(:)*gbasis%grid%rad2(:)
850
851 ! initialize basis function on a radial grid
852 nr = gbasis%grid%nr
853 m = maxval(gbasis%nbas)
854 ALLOCATE (gbasis%bf(nr, m, 0:lmat))
855 ALLOCATE (gbasis%dbf(nr, m, 0:lmat))
856 ALLOCATE (gbasis%ddbf(nr, m, 0:lmat))
857 gbasis%bf = 0._dp
858 gbasis%dbf = 0._dp
859 gbasis%ddbf = 0._dp
860
861 SELECT CASE (gbasis%basis_type)
862 CASE DEFAULT
863 cpabort("")
864 CASE (gto_basis)
865 DO l = 0, lmat
866 DO i = 1, gbasis%nbas(l)
867 al = gbasis%am(i, l)
868 DO k = 1, nr
869 rk = gbasis%grid%rad(k)
870 ear = exp(-al*gbasis%grid%rad(k)**2)
871 gbasis%bf(k, i, l) = rk**l*ear
872 gbasis%dbf(k, i, l) = (real(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear
873 gbasis%ddbf(k, i, l) = (real(l*(l - 1), dp)*rk**(l - 2) - &
874 2._dp*al*real(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear
875 END DO
876 END DO
877 END DO
878 CASE (cgto_basis)
879 DO l = 0, lmat
880 DO i = 1, gbasis%nprim(l)
881 al = gbasis%am(i, l)
882 DO k = 1, nr
883 rk = gbasis%grid%rad(k)
884 ear = exp(-al*gbasis%grid%rad(k)**2)
885 DO j = 1, gbasis%nbas(l)
886 gbasis%bf(k, j, l) = gbasis%bf(k, j, l) + rk**l*ear*gbasis%cm(i, j, l)
887 gbasis%dbf(k, j, l) = gbasis%dbf(k, j, l) &
888 + (real(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*gbasis%cm(i, j, l)
889 gbasis%ddbf(k, j, l) = gbasis%ddbf(k, j, l) + &
890 (real(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*real(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))* &
891 ear*gbasis%cm(i, j, l)
892 END DO
893 END DO
894 END DO
895 END DO
896 CASE (sto_basis)
897 DO l = 0, lmat
898 DO i = 1, gbasis%nbas(l)
899 al = gbasis%as(i, l)
900 nl = gbasis%ns(i, l)
901 pf = (2._dp*al)**nl*sqrt(2._dp*al/fac(2*nl))
902 DO k = 1, nr
903 rk = gbasis%grid%rad(k)
904 ear = rk**(nl - 1)*exp(-al*rk)
905 gbasis%bf(k, i, l) = pf*ear
906 gbasis%dbf(k, i, l) = pf*(real(nl - 1, dp)/rk - al)*ear
907 gbasis%ddbf(k, i, l) = pf*(real((nl - 2)*(nl - 1), dp)/rk/rk &
908 - al*real(2*(nl - 1), dp)/rk + al*al)*ear
909 END DO
910 END DO
911 END DO
912 CASE (num_basis)
913 gbasis%basis_type = num_basis
914 cpabort("")
915 END SELECT
916
917 END SUBROUTINE atom_basis_gridrep
918
919! **************************************************************************************************
920!> \brief ...
921!> \param basis ...
922! **************************************************************************************************
923 SUBROUTINE release_atom_basis(basis)
924 TYPE(atom_basis_type), INTENT(INOUT) :: basis
925
926 IF (ASSOCIATED(basis%am)) THEN
927 DEALLOCATE (basis%am)
928 END IF
929 IF (ASSOCIATED(basis%cm)) THEN
930 DEALLOCATE (basis%cm)
931 END IF
932 IF (ASSOCIATED(basis%as)) THEN
933 DEALLOCATE (basis%as)
934 END IF
935 IF (ASSOCIATED(basis%ns)) THEN
936 DEALLOCATE (basis%ns)
937 END IF
938 IF (ASSOCIATED(basis%bf)) THEN
939 DEALLOCATE (basis%bf)
940 END IF
941 IF (ASSOCIATED(basis%dbf)) THEN
942 DEALLOCATE (basis%dbf)
943 END IF
944 IF (ASSOCIATED(basis%ddbf)) THEN
945 DEALLOCATE (basis%ddbf)
946 END IF
947
948 CALL deallocate_grid_atom(basis%grid)
949
950 END SUBROUTINE release_atom_basis
951! **************************************************************************************************
952
953! **************************************************************************************************
954!> \brief ...
955!> \param atom ...
956! **************************************************************************************************
957 SUBROUTINE create_atom_type(atom)
958 TYPE(atom_type), POINTER :: atom
959
960 cpassert(.NOT. ASSOCIATED(atom))
961
962 ALLOCATE (atom)
963
964 NULLIFY (atom%zmp_section)
965 NULLIFY (atom%xc_section)
966 NULLIFY (atom%fmat)
967 atom%do_zmp = .false.
968 atom%doread = .false.
969 atom%read_vxc = .false.
970 atom%dm = .false.
971 atom%hfx_pot%scale_coulomb = 0.0_dp
972 atom%hfx_pot%scale_longrange = 0.0_dp
973 atom%hfx_pot%omega = 0.0_dp
974
975 END SUBROUTINE create_atom_type
976
977! **************************************************************************************************
978!> \brief ...
979!> \param atom ...
980! **************************************************************************************************
981 SUBROUTINE release_atom_type(atom)
982 TYPE(atom_type), POINTER :: atom
983
984 cpassert(ASSOCIATED(atom))
985
986 NULLIFY (atom%basis)
987 NULLIFY (atom%integrals)
988 IF (ASSOCIATED(atom%state)) THEN
989 DEALLOCATE (atom%state)
990 END IF
991 IF (ASSOCIATED(atom%orbitals)) THEN
992 CALL release_atom_orbs(atom%orbitals)
993 END IF
994
995 IF (ASSOCIATED(atom%fmat)) CALL release_opmat(atom%fmat)
996
997 DEALLOCATE (atom)
998
999 END SUBROUTINE release_atom_type
1000
1001! ZMP adding input variables in subroutine do_zmp,doread,read_vxc,method_type
1002! **************************************************************************************************
1003!> \brief ...
1004!> \param atom ...
1005!> \param basis ...
1006!> \param state ...
1007!> \param integrals ...
1008!> \param orbitals ...
1009!> \param potential ...
1010!> \param zcore ...
1011!> \param pp_calc ...
1012!> \param do_zmp ...
1013!> \param doread ...
1014!> \param read_vxc ...
1015!> \param method_type ...
1016!> \param relativistic ...
1017!> \param coulomb_integral_type ...
1018!> \param exchange_integral_type ...
1019!> \param fmat ...
1020! **************************************************************************************************
1021 SUBROUTINE set_atom(atom, basis, state, integrals, orbitals, potential, zcore, pp_calc, do_zmp, doread, &
1022 read_vxc, method_type, relativistic, coulomb_integral_type, exchange_integral_type, fmat)
1023 TYPE(atom_type), POINTER :: atom
1024 TYPE(atom_basis_type), OPTIONAL, POINTER :: basis
1025 TYPE(atom_state), OPTIONAL, POINTER :: state
1026 TYPE(atom_integrals), OPTIONAL, POINTER :: integrals
1027 TYPE(atom_orbitals), OPTIONAL, POINTER :: orbitals
1028 TYPE(atom_potential_type), OPTIONAL, POINTER :: potential
1029 INTEGER, INTENT(IN), OPTIONAL :: zcore
1030 LOGICAL, INTENT(IN), OPTIONAL :: pp_calc, do_zmp, doread, read_vxc
1031 INTEGER, INTENT(IN), OPTIONAL :: method_type, relativistic, &
1032 coulomb_integral_type, &
1033 exchange_integral_type
1034 TYPE(opmat_type), OPTIONAL, POINTER :: fmat
1035
1036 cpassert(ASSOCIATED(atom))
1037
1038 IF (PRESENT(basis)) atom%basis => basis
1039 IF (PRESENT(state)) atom%state => state
1040 IF (PRESENT(integrals)) atom%integrals => integrals
1041 IF (PRESENT(orbitals)) atom%orbitals => orbitals
1042 IF (PRESENT(potential)) atom%potential => potential
1043 IF (PRESENT(zcore)) atom%zcore = zcore
1044 IF (PRESENT(pp_calc)) atom%pp_calc = pp_calc
1045! ZMP assigning variable values if present
1046 IF (PRESENT(do_zmp)) atom%do_zmp = do_zmp
1047 IF (PRESENT(doread)) atom%doread = doread
1048 IF (PRESENT(read_vxc)) atom%read_vxc = read_vxc
1049
1050 IF (PRESENT(method_type)) atom%method_type = method_type
1051 IF (PRESENT(relativistic)) atom%relativistic = relativistic
1052 IF (PRESENT(coulomb_integral_type)) atom%coulomb_integral_type = coulomb_integral_type
1053 IF (PRESENT(exchange_integral_type)) atom%exchange_integral_type = exchange_integral_type
1054
1055 IF (PRESENT(fmat)) THEN
1056 IF (ASSOCIATED(atom%fmat)) CALL release_opmat(atom%fmat)
1057 atom%fmat => fmat
1058 END IF
1059
1060 END SUBROUTINE set_atom
1061
1062! **************************************************************************************************
1063!> \brief ...
1064!> \param orbs ...
1065!> \param mbas ...
1066!> \param mo ...
1067! **************************************************************************************************
1068 SUBROUTINE create_atom_orbs(orbs, mbas, mo)
1069 TYPE(atom_orbitals), POINTER :: orbs
1070 INTEGER, INTENT(IN) :: mbas, mo
1071
1072 cpassert(.NOT. ASSOCIATED(orbs))
1073
1074 ALLOCATE (orbs)
1075
1076 ALLOCATE (orbs%wfn(mbas, mo, 0:lmat), orbs%wfna(mbas, mo, 0:lmat), orbs%wfnb(mbas, mo, 0:lmat))
1077 orbs%wfn = 0._dp
1078 orbs%wfna = 0._dp
1079 orbs%wfnb = 0._dp
1080
1081 ALLOCATE (orbs%pmat(mbas, mbas, 0:lmat), orbs%pmata(mbas, mbas, 0:lmat), orbs%pmatb(mbas, mbas, 0:lmat))
1082 orbs%pmat = 0._dp
1083 orbs%pmata = 0._dp
1084 orbs%pmatb = 0._dp
1085
1086 ALLOCATE (orbs%ener(mo, 0:lmat), orbs%enera(mo, 0:lmat), orbs%enerb(mo, 0:lmat))
1087 orbs%ener = 0._dp
1088 orbs%enera = 0._dp
1089 orbs%enerb = 0._dp
1090
1091 ALLOCATE (orbs%refene(mo, 0:lmat, 2), orbs%refchg(mo, 0:lmat, 2), orbs%refnod(mo, 0:lmat, 2))
1092 orbs%refene = 0._dp
1093 orbs%refchg = 0._dp
1094 orbs%refnod = 0._dp
1095 ALLOCATE (orbs%wrefene(mo, 0:lmat, 2), orbs%wrefchg(mo, 0:lmat, 2), orbs%wrefnod(mo, 0:lmat, 2))
1096 orbs%wrefene = 0._dp
1097 orbs%wrefchg = 0._dp
1098 orbs%wrefnod = 0._dp
1099 ALLOCATE (orbs%crefene(mo, 0:lmat, 2), orbs%crefchg(mo, 0:lmat, 2), orbs%crefnod(mo, 0:lmat, 2))
1100 orbs%crefene = 0._dp
1101 orbs%crefchg = 0._dp
1102 orbs%crefnod = 0._dp
1103 ALLOCATE (orbs%rcmax(mo, 0:lmat, 2))
1104 orbs%rcmax = 0._dp
1105 ALLOCATE (orbs%wpsir0(mo, 2), orbs%tpsir0(mo, 2))
1106 orbs%wpsir0 = 0._dp
1107 orbs%tpsir0 = 0._dp
1108 ALLOCATE (orbs%reftype(mo, 0:lmat, 2))
1109 orbs%reftype = "XX"
1110
1111 END SUBROUTINE create_atom_orbs
1112
1113! **************************************************************************************************
1114!> \brief ...
1115!> \param orbs ...
1116! **************************************************************************************************
1117 SUBROUTINE release_atom_orbs(orbs)
1118 TYPE(atom_orbitals), POINTER :: orbs
1119
1120 cpassert(ASSOCIATED(orbs))
1121
1122 IF (ASSOCIATED(orbs%wfn)) THEN
1123 DEALLOCATE (orbs%wfn, orbs%wfna, orbs%wfnb)
1124 END IF
1125 IF (ASSOCIATED(orbs%pmat)) THEN
1126 DEALLOCATE (orbs%pmat, orbs%pmata, orbs%pmatb)
1127 END IF
1128 IF (ASSOCIATED(orbs%ener)) THEN
1129 DEALLOCATE (orbs%ener, orbs%enera, orbs%enerb)
1130 END IF
1131 IF (ASSOCIATED(orbs%refene)) THEN
1132 DEALLOCATE (orbs%refene)
1133 END IF
1134 IF (ASSOCIATED(orbs%refchg)) THEN
1135 DEALLOCATE (orbs%refchg)
1136 END IF
1137 IF (ASSOCIATED(orbs%refnod)) THEN
1138 DEALLOCATE (orbs%refnod)
1139 END IF
1140 IF (ASSOCIATED(orbs%wrefene)) THEN
1141 DEALLOCATE (orbs%wrefene)
1142 END IF
1143 IF (ASSOCIATED(orbs%wrefchg)) THEN
1144 DEALLOCATE (orbs%wrefchg)
1145 END IF
1146 IF (ASSOCIATED(orbs%wrefnod)) THEN
1147 DEALLOCATE (orbs%wrefnod)
1148 END IF
1149 IF (ASSOCIATED(orbs%crefene)) THEN
1150 DEALLOCATE (orbs%crefene)
1151 END IF
1152 IF (ASSOCIATED(orbs%crefchg)) THEN
1153 DEALLOCATE (orbs%crefchg)
1154 END IF
1155 IF (ASSOCIATED(orbs%crefnod)) THEN
1156 DEALLOCATE (orbs%crefnod)
1157 END IF
1158 IF (ASSOCIATED(orbs%rcmax)) THEN
1159 DEALLOCATE (orbs%rcmax)
1160 END IF
1161 IF (ASSOCIATED(orbs%wpsir0)) THEN
1162 DEALLOCATE (orbs%wpsir0)
1163 END IF
1164 IF (ASSOCIATED(orbs%tpsir0)) THEN
1165 DEALLOCATE (orbs%tpsir0)
1166 END IF
1167 IF (ASSOCIATED(orbs%reftype)) THEN
1168 DEALLOCATE (orbs%reftype)
1169 END IF
1170
1171 DEALLOCATE (orbs)
1172
1173 END SUBROUTINE release_atom_orbs
1174
1175! **************************************************************************************************
1176!> \brief ...
1177!> \param hf_frac ...
1178!> \param do_hfx ...
1179!> \param atom ...
1180!> \param xc_section ...
1181!> \param extype ...
1182! **************************************************************************************************
1183 SUBROUTINE setup_hf_section(hf_frac, do_hfx, atom, xc_section, extype)
1184 REAL(kind=dp), INTENT(OUT) :: hf_frac
1185 LOGICAL, INTENT(OUT) :: do_hfx
1186 TYPE(atom_type), INTENT(IN), POINTER :: atom
1187 TYPE(section_vals_type), POINTER :: xc_section
1188 INTEGER, INTENT(IN) :: extype
1189
1190 INTEGER :: i, j, nr, nu, pot_type
1191 REAL(kind=dp) :: scale_coulomb, scale_longrange
1192 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: abscissa, weights
1193 TYPE(section_vals_type), POINTER :: hf_sub_section, hfx_sections
1194
1195 hf_frac = 0._dp
1196 IF (ASSOCIATED(atom%xc_section)) THEN
1197 xc_section => atom%xc_section
1198 hfx_sections => section_vals_get_subs_vals(xc_section, "HF")
1199 CALL section_vals_get(hfx_sections, explicit=do_hfx)
1200
1201 ! If nothing has been set explicitly, assume a Coulomb potential
1202 atom%hfx_pot%scale_longrange = 0.0_dp
1203 atom%hfx_pot%scale_coulomb = 1.0_dp
1204
1205 IF (do_hfx) THEN
1206 CALL section_vals_val_get(hfx_sections, "FRACTION", r_val=hf_frac)
1207
1208 ! Get potential info
1209 hf_sub_section => section_vals_get_subs_vals(hfx_sections, "INTERACTION_POTENTIAL", i_rep_section=1)
1210 CALL section_vals_val_get(hf_sub_section, "POTENTIAL_TYPE", i_val=pot_type)
1211 CALL section_vals_val_get(hf_sub_section, "OMEGA", r_val=atom%hfx_pot%omega)
1212 CALL section_vals_val_get(hf_sub_section, "SCALE_COULOMB", r_val=scale_coulomb)
1213 CALL section_vals_val_get(hf_sub_section, "SCALE_LONGRANGE", r_val=scale_longrange)
1214
1215 ! Setup atomic hfx potential
1216 SELECT CASE (pot_type)
1217 CASE DEFAULT
1218 cpwarn("Potential not implemented, use Coulomb instead!")
1220 atom%hfx_pot%scale_longrange = 0.0_dp
1221 atom%hfx_pot%scale_coulomb = scale_coulomb
1222 CASE (do_potential_long)
1223 atom%hfx_pot%scale_coulomb = 0.0_dp
1224 atom%hfx_pot%scale_longrange = scale_longrange
1225 CASE (do_potential_short)
1226 atom%hfx_pot%scale_coulomb = 1.0_dp
1227 atom%hfx_pot%scale_longrange = -1.0_dp
1228 CASE (do_potential_mix_cl)
1229 atom%hfx_pot%scale_coulomb = scale_coulomb
1230 atom%hfx_pot%scale_longrange = scale_longrange
1231 END SELECT
1232 END IF
1233
1234 ! Check whether extype is supported
1235 IF (atom%hfx_pot%scale_longrange /= 0.0_dp .AND. extype /= do_numeric .AND. extype /= do_semi_analytic) THEN
1236 cpabort("Only numerical and semi-analytic lrHF exchange available!")
1237 END IF
1238
1239 IF (atom%hfx_pot%scale_longrange /= 0.0_dp .AND. extype == do_numeric .AND. .NOT. ALLOCATED(atom%hfx_pot%kernel)) THEN
1240 CALL cite_reference(limpanuparb2011)
1241
1242 IF (atom%hfx_pot%do_gh) THEN
1243 ! Setup kernel for Ewald operator
1244 ! Because of the high computational costs of its calculation, we precalculate it here
1245 ! Use Gauss-Hermite grid instead of the external grid
1246 ALLOCATE (weights(atom%hfx_pot%nr_gh), abscissa(atom%hfx_pot%nr_gh))
1247 CALL get_gauss_hermite_weights(abscissa, weights, atom%hfx_pot%nr_gh)
1248
1249 nr = atom%basis%grid%nr
1250 ALLOCATE (atom%hfx_pot%kernel(nr, atom%hfx_pot%nr_gh, 0:atom%state%maxl_calc + atom%state%maxl_occ))
1251 atom%hfx_pot%kernel = 0.0_dp
1252 DO nu = 0, atom%state%maxl_calc + atom%state%maxl_occ
1253 DO i = 1, atom%hfx_pot%nr_gh
1254 DO j = 1, nr
1255 atom%hfx_pot%kernel(j, i, nu) = bessel0(2.0_dp*atom%hfx_pot%omega &
1256 *abscissa(i)*atom%basis%grid%rad(j), nu)*sqrt(weights(i))
1257 END DO
1258 END DO
1259 END DO
1260 ELSE
1261 ! Setup kernel for Ewald operator
1262 ! Because of the high computational costs of its calculation, we precalculate it here
1263 ! Choose it symmetric to further reduce the costs
1264 nr = atom%basis%grid%nr
1265 ALLOCATE (atom%hfx_pot%kernel(nr, nr, 0:atom%state%maxl_calc + atom%state%maxl_occ))
1266 atom%hfx_pot%kernel = 0.0_dp
1267 DO nu = 0, atom%state%maxl_calc + atom%state%maxl_occ
1268 DO i = 1, nr
1269 DO j = 1, i
1270 atom%hfx_pot%kernel(j, i, nu) = bessel0(2.0_dp*atom%hfx_pot%omega &
1271 *atom%basis%grid%rad(i)*atom%basis%grid%rad(j), nu)
1272 END DO
1273 END DO
1274 END DO
1275 END IF
1276 END IF
1277 ELSE
1278 NULLIFY (xc_section)
1279 do_hfx = .false.
1280 END IF
1281
1282 END SUBROUTINE setup_hf_section
1283
1284! **************************************************************************************************
1285!> \brief ...
1286!> \param abscissa ...
1287!> \param weights ...
1288!> \param nn ...
1289! **************************************************************************************************
1290 SUBROUTINE get_gauss_hermite_weights(abscissa, weights, nn)
1291 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: abscissa, weights
1292 INTEGER, INTENT(IN) :: nn
1293
1294 INTEGER :: counter, ii, info, liwork, lwork
1295 INTEGER, ALLOCATABLE, DIMENSION(:) :: iwork
1296 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: diag, subdiag, work
1297 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: eigenvec
1298
1299 ! Setup matrix for Golub-Welsch-algorithm to determine roots and weights of Gauss-Hermite quadrature
1300 ! If necessary, one can setup matrices differently for other quadratures
1301 ALLOCATE (work(1), iwork(1), diag(2*nn), subdiag(2*nn - 1), eigenvec(2*nn, 2*nn))
1302 lwork = -1
1303 liwork = -1
1304 diag = 0.0_dp
1305 DO ii = 1, 2*nn - 1
1306 subdiag(ii) = sqrt(real(ii, kind=dp)/2.0_dp)
1307 END DO
1308
1309 ! Get correct size for working matrices
1310 CALL dstevd('V', 2*nn, diag, subdiag, eigenvec, 2*nn, work, lwork, iwork, liwork, info)
1311 IF (info /= 0) THEN
1312 ! This should not happen!
1313 cpabort('Finding size of working matrices failed!')
1314 END IF
1315
1316 ! Setup working matrices with their respective optimal sizes
1317 lwork = int(work(1))
1318 liwork = iwork(1)
1319 DEALLOCATE (work, iwork)
1320 ALLOCATE (work(lwork), iwork(liwork))
1321
1322 ! Perform the actual eigenvalue decomposition
1323 CALL dstevd('V', 2*nn, diag, subdiag, eigenvec, 2*nn, work, lwork, iwork, liwork, info)
1324 IF (info /= 0) THEN
1325 ! This should not happen for the usual values of nn! (Checked for nn = 2000)
1326 cpabort('Eigenvalue decomposition failed!')
1327 END IF
1328
1329 DEALLOCATE (work, iwork, subdiag)
1330
1331 ! Identify positive roots of hermite polynomials (zeros of Hermite polynomials are symmetric wrt the origin)
1332 ! We will only keep the positive roots
1333 counter = 0
1334 DO ii = 1, 2*nn
1335 IF (diag(ii) > 0.0_dp) THEN
1336 counter = counter + 1
1337 abscissa(counter) = diag(ii)
1338 weights(counter) = rootpi*eigenvec(1, ii)**2
1339 END IF
1340 END DO
1341 IF (counter /= nn) THEN
1342 cpabort('Have not found enough or too many zeros!')
1343 END IF
1344
1345 END SUBROUTINE get_gauss_hermite_weights
1346
1347! **************************************************************************************************
1348!> \brief ...
1349!> \param opmat ...
1350!> \param n ...
1351!> \param lmax ...
1352! **************************************************************************************************
1353 SUBROUTINE create_opmat(opmat, n, lmax)
1354 TYPE(opmat_type), POINTER :: opmat
1355 INTEGER, DIMENSION(0:lmat), INTENT(IN) :: n
1356 INTEGER, INTENT(IN), OPTIONAL :: lmax
1357
1358 INTEGER :: lm, m
1359
1360 m = maxval(n)
1361 IF (PRESENT(lmax)) THEN
1362 lm = lmax
1363 ELSE
1364 lm = lmat
1365 END IF
1366
1367 cpassert(.NOT. ASSOCIATED(opmat))
1368
1369 ALLOCATE (opmat)
1370
1371 opmat%n = n
1372 ALLOCATE (opmat%op(m, m, 0:lm))
1373 opmat%op = 0._dp
1374
1375 END SUBROUTINE create_opmat
1376
1377! **************************************************************************************************
1378!> \brief ...
1379!> \param opmat ...
1380! **************************************************************************************************
1381 SUBROUTINE release_opmat(opmat)
1382 TYPE(opmat_type), POINTER :: opmat
1383
1384 cpassert(ASSOCIATED(opmat))
1385
1386 opmat%n = 0
1387 DEALLOCATE (opmat%op)
1388
1389 DEALLOCATE (opmat)
1390
1391 END SUBROUTINE release_opmat
1392
1393! **************************************************************************************************
1394!> \brief ...
1395!> \param opgrid ...
1396!> \param grid ...
1397! **************************************************************************************************
1398 SUBROUTINE create_opgrid(opgrid, grid)
1399 TYPE(opgrid_type), POINTER :: opgrid
1400 TYPE(grid_atom_type), POINTER :: grid
1401
1402 INTEGER :: nr
1403
1404 cpassert(.NOT. ASSOCIATED(opgrid))
1405
1406 ALLOCATE (opgrid)
1407
1408 opgrid%grid => grid
1409
1410 nr = grid%nr
1411
1412 ALLOCATE (opgrid%op(nr))
1413 opgrid%op = 0._dp
1414
1415 END SUBROUTINE create_opgrid
1416
1417! **************************************************************************************************
1418!> \brief ...
1419!> \param opgrid ...
1420! **************************************************************************************************
1421 SUBROUTINE release_opgrid(opgrid)
1422 TYPE(opgrid_type), POINTER :: opgrid
1423
1424 cpassert(ASSOCIATED(opgrid))
1425
1426 NULLIFY (opgrid%grid)
1427 DEALLOCATE (opgrid%op)
1428
1429 DEALLOCATE (opgrid)
1430
1431 END SUBROUTINE release_opgrid
1432
1433! **************************************************************************************************
1434!> \brief ...
1435!> \param zval ...
1436!> \param cval ...
1437!> \param aval ...
1438!> \param ngto ...
1439!> \param ival ...
1440! **************************************************************************************************
1441 SUBROUTINE clementi_geobas(zval, cval, aval, ngto, ival)
1442 INTEGER, INTENT(IN) :: zval
1443 REAL(dp), INTENT(OUT) :: cval, aval
1444 INTEGER, DIMENSION(0:lmat), INTENT(OUT) :: ngto, ival
1445
1446 ngto = 0
1447 ival = 0
1448 cval = 0._dp
1449 aval = 0._dp
1450
1451 SELECT CASE (zval)
1452 CASE DEFAULT
1453 cpabort("")
1454 CASE (1) ! this is from the general geometrical basis and extended
1455 cval = 2.0_dp
1456 aval = 0.016_dp
1457 ngto(0) = 20
1458 CASE (2)
1459 cval = 2.14774520_dp
1460 aval = 0.04850670_dp
1461 ngto(0) = 20
1462 CASE (3)
1463 cval = 2.08932430_dp
1464 aval = 0.02031060_dp
1465 ngto(0) = 23
1466 CASE (4)
1467 cval = 2.09753060_dp
1468 aval = 0.03207070_dp
1469 ngto(0) = 23
1470 CASE (5)
1471 cval = 2.10343410_dp
1472 aval = 0.03591970_dp
1473 ngto(0) = 23
1474 ngto(1) = 16
1475 CASE (6)
1476 cval = 2.10662820_dp
1477 aval = 0.05292410_dp
1478 ngto(0) = 23
1479 ngto(1) = 16
1480 CASE (7)
1481 cval = 2.13743840_dp
1482 aval = 0.06291970_dp
1483 ngto(0) = 23
1484 ngto(1) = 16
1485 CASE (8)
1486 cval = 2.08687310_dp
1487 aval = 0.08350860_dp
1488 ngto(0) = 23
1489 ngto(1) = 16
1490 CASE (9)
1491 cval = 2.12318180_dp
1492 aval = 0.09899170_dp
1493 ngto(0) = 23
1494 ngto(1) = 16
1495 CASE (10)
1496 cval = 2.13164810_dp
1497 aval = 0.11485350_dp
1498 ngto(0) = 23
1499 ngto(1) = 16
1500 CASE (11)
1501 cval = 2.11413310_dp
1502 aval = 0.00922630_dp
1503 ngto(0) = 26
1504 ngto(1) = 16
1505 ival(1) = 4
1506 CASE (12)
1507 cval = 2.12183620_dp
1508 aval = 0.01215850_dp
1509 ngto(0) = 26
1510 ngto(1) = 16
1511 ival(1) = 4
1512 CASE (13)
1513 cval = 2.06073230_dp
1514 aval = 0.01449350_dp
1515 ngto(0) = 26
1516 ngto(1) = 20
1517 ival(0) = 1
1518 CASE (14)
1519 cval = 2.08563660_dp
1520 aval = 0.01861460_dp
1521 ngto(0) = 26
1522 ngto(1) = 20
1523 ival(0) = 1
1524 CASE (15)
1525 cval = 2.04879270_dp
1526 aval = 0.02147790_dp
1527 ngto(0) = 26
1528 ngto(1) = 20
1529 ival(0) = 1
1530 CASE (16)
1531 cval = 2.06216660_dp
1532 aval = 0.01978920_dp
1533 ngto(0) = 26
1534 ngto(1) = 20
1535 ival(0) = 1
1536 CASE (17)
1537 cval = 2.04628670_dp
1538 aval = 0.02451470_dp
1539 ngto(0) = 26
1540 ngto(1) = 20
1541 ival(0) = 1
1542 CASE (18)
1543 cval = 2.08675200_dp
1544 aval = 0.02635040_dp
1545 ngto(0) = 26
1546 ngto(1) = 20
1547 ival(0) = 1
1548 CASE (19)
1549 cval = 2.02715220_dp
1550 aval = 0.01822040_dp
1551 ngto(0) = 29
1552 ngto(1) = 20
1553 ival(1) = 2
1554 CASE (20)
1555 cval = 2.01465650_dp
1556 aval = 0.01646570_dp
1557 ngto(0) = 29
1558 ngto(1) = 20
1559 ival(1) = 2
1560 CASE (21)
1561 cval = 2.01605240_dp
1562 aval = 0.01254190_dp
1563 ngto(0) = 30
1564 ngto(1) = 20
1565 ngto(2) = 18
1566 ival(1) = 2
1567 CASE (22)
1568 cval = 2.01800000_dp
1569 aval = 0.01195490_dp
1570 ngto(0) = 30
1571 ngto(1) = 21
1572 ngto(2) = 17
1573 ival(1) = 2
1574 ival(2) = 1
1575 CASE (23)
1576 cval = 1.98803560_dp
1577 aval = 0.02492140_dp
1578 ngto(0) = 30
1579 ngto(1) = 21
1580 ngto(2) = 17
1581 ival(1) = 2
1582 ival(2) = 1
1583 CASE (24)
1584 cval = 1.98984000_dp
1585 aval = 0.02568400_dp
1586 ngto(0) = 30
1587 ngto(1) = 21
1588 ngto(2) = 17
1589 ival(1) = 2
1590 ival(2) = 1
1591 CASE (25)
1592 cval = 2.01694380_dp
1593 aval = 0.02664480_dp
1594 ngto(0) = 30
1595 ngto(1) = 21
1596 ngto(2) = 17
1597 ival(1) = 2
1598 ival(2) = 1
1599 CASE (26)
1600 cval = 2.01824090_dp
1601 aval = 0.01355000_dp
1602 ngto(0) = 30
1603 ngto(1) = 21
1604 ngto(2) = 17
1605 ival(1) = 2
1606 ival(2) = 1
1607 CASE (27)
1608 cval = 1.98359400_dp
1609 aval = 0.01702210_dp
1610 ngto(0) = 30
1611 ngto(1) = 21
1612 ngto(2) = 17
1613 ival(1) = 2
1614 ival(2) = 2
1615 CASE (28)
1616 cval = 1.96797340_dp
1617 aval = 0.02163180_dp
1618 ngto(0) = 30
1619 ngto(1) = 22
1620 ngto(2) = 17
1621 ival(1) = 3
1622 ival(2) = 2
1623 CASE (29)
1624 cval = 1.98955180_dp
1625 aval = 0.02304480_dp
1626 ngto(0) = 30
1627 ngto(1) = 20
1628 ngto(2) = 17
1629 ival(1) = 3
1630 ival(2) = 2
1631 CASE (30)
1632 cval = 1.98074320_dp
1633 aval = 0.02754320_dp
1634 ngto(0) = 30
1635 ngto(1) = 21
1636 ngto(2) = 17
1637 ival(1) = 3
1638 ival(2) = 2
1639 CASE (31)
1640 cval = 2.00551070_dp
1641 aval = 0.02005530_dp
1642 ngto(0) = 30
1643 ngto(1) = 23
1644 ngto(2) = 17
1645 ival(0) = 1
1646 ival(2) = 2
1647 CASE (32)
1648 cval = 2.00000030_dp
1649 aval = 0.02003000_dp
1650 ngto(0) = 30
1651 ngto(1) = 24
1652 ngto(2) = 17
1653 ival(0) = 1
1654 ival(2) = 2
1655 CASE (33)
1656 cval = 2.00609100_dp
1657 aval = 0.02055620_dp
1658 ngto(0) = 30
1659 ngto(1) = 23
1660 ngto(2) = 17
1661 ival(0) = 1
1662 ival(2) = 2
1663 CASE (34)
1664 cval = 2.00701000_dp
1665 aval = 0.02230400_dp
1666 ngto(0) = 30
1667 ngto(1) = 24
1668 ngto(2) = 17
1669 ival(0) = 1
1670 ival(2) = 2
1671 CASE (35)
1672 cval = 2.01508710_dp
1673 aval = 0.02685790_dp
1674 ngto(0) = 30
1675 ngto(1) = 24
1676 ngto(2) = 17
1677 ival(0) = 1
1678 ival(2) = 2
1679 CASE (36)
1680 cval = 2.01960430_dp
1681 aval = 0.02960430_dp
1682 ngto(0) = 30
1683 ngto(1) = 24
1684 ngto(2) = 17
1685 ival(0) = 1
1686 ival(2) = 2
1687 CASE (37)
1688 cval = 2.00031000_dp
1689 aval = 0.00768400_dp
1690 ngto(0) = 32
1691 ngto(1) = 25
1692 ngto(2) = 17
1693 ival(0) = 1
1694 ival(1) = 1
1695 ival(2) = 4
1696 CASE (38)
1697 cval = 1.99563960_dp
1698 aval = 0.01401940_dp
1699 ngto(0) = 33
1700 ngto(1) = 24
1701 ngto(2) = 17
1702 ival(1) = 1
1703 ival(2) = 4
1704 CASE (39)
1705 cval = 1.98971210_dp
1706 aval = 0.01558470_dp
1707 ngto(0) = 33
1708 ngto(1) = 24
1709 ngto(2) = 20
1710 ival(1) = 1
1711 CASE (40)
1712 cval = 1.97976190_dp
1713 aval = 0.01705520_dp
1714 ngto(0) = 33
1715 ngto(1) = 24
1716 ngto(2) = 20
1717 ival(1) = 1
1718 CASE (41)
1719 cval = 1.97989290_dp
1720 aval = 0.01527040_dp
1721 ngto(0) = 33
1722 ngto(1) = 24
1723 ngto(2) = 20
1724 ival(1) = 1
1725 CASE (42)
1726 cval = 1.97909240_dp
1727 aval = 0.01879720_dp
1728 ngto(0) = 32
1729 ngto(1) = 24
1730 ngto(2) = 20
1731 ival(1) = 1
1732 CASE (43)
1733 cval = 1.98508430_dp
1734 aval = 0.01497550_dp
1735 ngto(0) = 32
1736 ngto(1) = 24
1737 ngto(2) = 20
1738 ival(1) = 2
1739 ival(2) = 1
1740 CASE (44)
1741 cval = 1.98515010_dp
1742 aval = 0.01856670_dp
1743 ngto(0) = 32
1744 ngto(1) = 24
1745 ngto(2) = 20
1746 ival(1) = 2
1747 ival(2) = 1
1748 CASE (45)
1749 cval = 1.98502970_dp
1750 aval = 0.01487000_dp
1751 ngto(0) = 32
1752 ngto(1) = 24
1753 ngto(2) = 20
1754 ival(1) = 2
1755 ival(2) = 1
1756 CASE (46)
1757 cval = 1.97672850_dp
1758 aval = 0.01762500_dp
1759 ngto(0) = 30
1760 ngto(1) = 24
1761 ngto(2) = 20
1762 ival(0) = 2
1763 ival(1) = 2
1764 ival(2) = 1
1765 CASE (47)
1766 cval = 1.97862730_dp
1767 aval = 0.01863310_dp
1768 ngto(0) = 32
1769 ngto(1) = 24
1770 ngto(2) = 20
1771 ival(1) = 2
1772 ival(2) = 1
1773 CASE (48)
1774 cval = 1.97990020_dp
1775 aval = 0.01347150_dp
1776 ngto(0) = 33
1777 ngto(1) = 24
1778 ngto(2) = 20
1779 ival(1) = 2
1780 ival(2) = 2
1781 CASE (49)
1782 cval = 1.97979410_dp
1783 aval = 0.00890265_dp
1784 ngto(0) = 33
1785 ngto(1) = 27
1786 ngto(2) = 20
1787 ival(0) = 2
1788 ival(2) = 2
1789 CASE (50)
1790 cval = 1.98001000_dp
1791 aval = 0.00895215_dp
1792 ngto(0) = 33
1793 ngto(1) = 27
1794 ngto(2) = 20
1795 ival(0) = 2
1796 ival(2) = 2
1797 CASE (51)
1798 cval = 1.97979980_dp
1799 aval = 0.01490290_dp
1800 ngto(0) = 33
1801 ngto(1) = 26
1802 ngto(2) = 20
1803 ival(1) = 1
1804 ival(2) = 2
1805 CASE (52)
1806 cval = 1.98009310_dp
1807 aval = 0.01490390_dp
1808 ngto(0) = 33
1809 ngto(1) = 26
1810 ngto(2) = 20
1811 ival(1) = 1
1812 ival(2) = 2
1813 CASE (53)
1814 cval = 1.97794750_dp
1815 aval = 0.01425880_dp
1816 ngto(0) = 33
1817 ngto(1) = 26
1818 ngto(2) = 20
1819 ival(0) = 2
1820 ival(1) = 1
1821 ival(2) = 2
1822 CASE (54)
1823 cval = 1.97784450_dp
1824 aval = 0.01430130_dp
1825 ngto(0) = 33
1826 ngto(1) = 26
1827 ngto(2) = 20
1828 ival(0) = 2
1829 ival(1) = 1
1830 ival(2) = 2
1831 CASE (55)
1832 cval = 1.97784450_dp
1833 aval = 0.00499318_dp
1834 ngto(0) = 32
1835 ngto(1) = 25
1836 ngto(2) = 17
1837 ival(0) = 1
1838 ival(1) = 3
1839 ival(2) = 6
1840 CASE (56)
1841 cval = 1.97764820_dp
1842 aval = 0.00500392_dp
1843 ngto(0) = 32
1844 ngto(1) = 25
1845 ngto(2) = 17
1846 ival(0) = 1
1847 ival(1) = 3
1848 ival(2) = 6
1849 CASE (57)
1850 cval = 1.97765150_dp
1851 aval = 0.00557083_dp
1852 ngto(0) = 32
1853 ngto(1) = 25
1854 ngto(2) = 20
1855 ival(0) = 1
1856 ival(1) = 3
1857 ival(2) = 3
1858 CASE (58)
1859 cval = 1.97768750_dp
1860 aval = 0.00547531_dp
1861 ngto(0) = 32
1862 ngto(1) = 25
1863 ngto(2) = 20
1864 ngto(3) = 16
1865 ival(0) = 1
1866 ival(1) = 3
1867 ival(2) = 3
1868 ival(3) = 3
1869 CASE (59)
1870 cval = 1.96986600_dp
1871 aval = 0.00813143_dp
1872 ngto(0) = 32
1873 ngto(1) = 25
1874 ngto(2) = 17
1875 ngto(3) = 16
1876 ival(0) = 1
1877 ival(1) = 3
1878 ival(2) = 6
1879 ival(3) = 4
1880 CASE (60)
1881 cval = 1.97765720_dp
1882 aval = 0.00489201_dp
1883 ngto(0) = 32
1884 ngto(1) = 25
1885 ngto(2) = 17
1886 ngto(3) = 16
1887 ival(0) = 1
1888 ival(1) = 3
1889 ival(2) = 6
1890 ival(3) = 4
1891 CASE (61)
1892 cval = 1.97768120_dp
1893 aval = 0.00499000_dp
1894 ngto(0) = 32
1895 ngto(1) = 25
1896 ngto(2) = 17
1897 ngto(3) = 16
1898 ival(0) = 1
1899 ival(1) = 3
1900 ival(2) = 6
1901 ival(3) = 4
1902 CASE (62)
1903 cval = 1.97745700_dp
1904 aval = 0.00615587_dp
1905 ngto(0) = 32
1906 ngto(1) = 25
1907 ngto(2) = 17
1908 ngto(3) = 16
1909 ival(0) = 1
1910 ival(1) = 3
1911 ival(2) = 6
1912 ival(3) = 4
1913 CASE (63)
1914 cval = 1.97570240_dp
1915 aval = 0.00769959_dp
1916 ngto(0) = 32
1917 ngto(1) = 25
1918 ngto(2) = 17
1919 ngto(3) = 16
1920 ival(0) = 1
1921 ival(1) = 3
1922 ival(2) = 6
1923 ival(3) = 4
1924 CASE (64)
1925 cval = 1.97629350_dp
1926 aval = 0.00706610_dp
1927 ngto(0) = 32
1928 ngto(1) = 25
1929 ngto(2) = 20
1930 ngto(3) = 16
1931 ival(0) = 1
1932 ival(1) = 3
1933 ival(2) = 3
1934 ival(3) = 4
1935 CASE (65)
1936 cval = 1.96900000_dp
1937 aval = 0.01019150_dp
1938 ngto(0) = 32
1939 ngto(1) = 26
1940 ngto(2) = 18
1941 ngto(3) = 16
1942 ival(0) = 1
1943 ival(1) = 3
1944 ival(2) = 6
1945 ival(3) = 4
1946 CASE (66)
1947 cval = 1.97350000_dp
1948 aval = 0.01334320_dp
1949 ngto(0) = 33
1950 ngto(1) = 26
1951 ngto(2) = 18
1952 ngto(3) = 16
1953 ival(0) = 1
1954 ival(1) = 3
1955 ival(2) = 6
1956 ival(3) = 4
1957 CASE (67)
1958 cval = 1.97493000_dp
1959 aval = 0.01331360_dp
1960 ngto(0) = 32
1961 ngto(1) = 24
1962 ngto(2) = 17
1963 ngto(3) = 14
1964 ival(1) = 2
1965 ival(2) = 5
1966 ival(3) = 4
1967 CASE (68)
1968 cval = 1.97597670_dp
1969 aval = 0.01434040_dp
1970 ngto(0) = 32
1971 ngto(1) = 24
1972 ngto(2) = 17
1973 ngto(3) = 14
1974 ival(0) = 0
1975 ival(1) = 2
1976 ival(2) = 5
1977 ival(3) = 4
1978 CASE (69)
1979 cval = 1.97809240_dp
1980 aval = 0.01529430_dp
1981 ngto(0) = 32
1982 ngto(1) = 24
1983 ngto(2) = 17
1984 ngto(3) = 14
1985 ival(0) = 0
1986 ival(1) = 2
1987 ival(2) = 5
1988 ival(3) = 4
1989 CASE (70)
1990 cval = 1.97644360_dp
1991 aval = 0.01312770_dp
1992 ngto(0) = 32
1993 ngto(1) = 24
1994 ngto(2) = 17
1995 ngto(3) = 14
1996 ival(0) = 0
1997 ival(1) = 2
1998 ival(2) = 5
1999 ival(3) = 4
2000 CASE (71)
2001 cval = 1.96998000_dp
2002 aval = 0.01745150_dp
2003 ngto(0) = 31
2004 ngto(1) = 24
2005 ngto(2) = 20
2006 ngto(3) = 14
2007 ival(0) = 1
2008 ival(1) = 2
2009 ival(2) = 2
2010 ival(3) = 4
2011 CASE (72)
2012 cval = 1.97223830_dp
2013 aval = 0.01639750_dp
2014 ngto(0) = 31
2015 ngto(1) = 24
2016 ngto(2) = 20
2017 ngto(3) = 14
2018 ival(0) = 1
2019 ival(1) = 2
2020 ival(2) = 2
2021 ival(3) = 4
2022 CASE (73)
2023 cval = 1.97462110_dp
2024 aval = 0.01603680_dp
2025 ngto(0) = 31
2026 ngto(1) = 24
2027 ngto(2) = 20
2028 ngto(3) = 14
2029 ival(0) = 1
2030 ival(1) = 2
2031 ival(2) = 2
2032 ival(3) = 4
2033 CASE (74)
2034 cval = 1.97756000_dp
2035 aval = 0.02030570_dp
2036 ngto(0) = 31
2037 ngto(1) = 24
2038 ngto(2) = 20
2039 ngto(3) = 14
2040 ival(0) = 1
2041 ival(1) = 2
2042 ival(2) = 2
2043 ival(3) = 4
2044 CASE (75)
2045 cval = 1.97645760_dp
2046 aval = 0.02057180_dp
2047 ngto(0) = 31
2048 ngto(1) = 24
2049 ngto(2) = 20
2050 ngto(3) = 14
2051 ival(0) = 1
2052 ival(1) = 2
2053 ival(2) = 2
2054 ival(3) = 4
2055 CASE (76)
2056 cval = 1.97725820_dp
2057 aval = 0.02058210_dp
2058 ngto(0) = 32
2059 ngto(1) = 24
2060 ngto(2) = 20
2061 ngto(3) = 15
2062 ival(0) = 0
2063 ival(1) = 2
2064 ival(2) = 2
2065 ival(3) = 4
2066 CASE (77)
2067 cval = 1.97749380_dp
2068 aval = 0.02219380_dp
2069 ngto(0) = 32
2070 ngto(1) = 24
2071 ngto(2) = 20
2072 ngto(3) = 15
2073 ival(0) = 0
2074 ival(1) = 2
2075 ival(2) = 2
2076 ival(3) = 4
2077 CASE (78)
2078 cval = 1.97946280_dp
2079 aval = 0.02216280_dp
2080 ngto(0) = 32
2081 ngto(1) = 24
2082 ngto(2) = 20
2083 ngto(3) = 15
2084 ival(0) = 0
2085 ival(1) = 2
2086 ival(2) = 2
2087 ival(3) = 4
2088 CASE (79)
2089 cval = 1.97852130_dp
2090 aval = 0.02168500_dp
2091 ngto(0) = 32
2092 ngto(1) = 24
2093 ngto(2) = 20
2094 ngto(3) = 15
2095 ival(0) = 0
2096 ival(1) = 2
2097 ival(2) = 2
2098 ival(3) = 4
2099 CASE (80)
2100 cval = 1.98045190_dp
2101 aval = 0.02177860_dp
2102 ngto(0) = 32
2103 ngto(1) = 24
2104 ngto(2) = 20
2105 ngto(3) = 15
2106 ival(0) = 0
2107 ival(1) = 2
2108 ival(2) = 2
2109 ival(3) = 4
2110 CASE (81)
2111 cval = 1.97000000_dp
2112 aval = 0.02275000_dp
2113 ngto(0) = 31
2114 ngto(1) = 25
2115 ngto(2) = 18
2116 ngto(3) = 13
2117 ival(0) = 1
2118 ival(1) = 0
2119 ival(2) = 3
2120 ival(3) = 6
2121 CASE (82)
2122 cval = 1.97713580_dp
2123 aval = 0.02317030_dp
2124 ngto(0) = 31
2125 ngto(1) = 27
2126 ngto(2) = 18
2127 ngto(3) = 13
2128 ival(0) = 1
2129 ival(1) = 0
2130 ival(2) = 3
2131 ival(3) = 6
2132 CASE (83)
2133 cval = 1.97537880_dp
2134 aval = 0.02672860_dp
2135 ngto(0) = 32
2136 ngto(1) = 27
2137 ngto(2) = 17
2138 ngto(3) = 13
2139 ival(0) = 1
2140 ival(1) = 0
2141 ival(2) = 3
2142 ival(3) = 6
2143 CASE (84)
2144 cval = 1.97545360_dp
2145 aval = 0.02745360_dp
2146 ngto(0) = 31
2147 ngto(1) = 27
2148 ngto(2) = 17
2149 ngto(3) = 13
2150 ival(0) = 1
2151 ival(1) = 0
2152 ival(2) = 3
2153 ival(3) = 6
2154 CASE (85)
2155 cval = 1.97338370_dp
2156 aval = 0.02616310_dp
2157 ngto(0) = 32
2158 ngto(1) = 27
2159 ngto(2) = 19
2160 ngto(3) = 13
2161 ival(0) = 1
2162 ival(1) = 0
2163 ival(2) = 3
2164 ival(3) = 6
2165 CASE (86)
2166 cval = 1.97294240_dp
2167 aval = 0.02429220_dp
2168 ngto(0) = 32
2169 ngto(1) = 27
2170 ngto(2) = 19
2171 ngto(3) = 13
2172 ival(0) = 1
2173 ival(1) = 0
2174 ival(2) = 3
2175 ival(3) = 6
2176 CASE (87:106) ! these numbers are an educated guess
2177 cval = 1.98000000_dp
2178 aval = 0.01400000_dp
2179 ngto(0) = 34
2180 ngto(1) = 28
2181 ngto(2) = 20
2182 ngto(3) = 15
2183 ival(0) = 0
2184 ival(1) = 0
2185 ival(2) = 3
2186 ival(3) = 6
2187 END SELECT
2188
2189 END SUBROUTINE clementi_geobas
2190! **************************************************************************************************
2191!> \brief ...
2192!> \param element_symbol ...
2193!> \param basis ...
2194!> \param basis_set_name ...
2195!> \param basis_set_file ...
2196!> \param basis_section ...
2197! **************************************************************************************************
2198 SUBROUTINE read_basis_set(element_symbol, basis, basis_set_name, basis_set_file, &
2199 basis_section)
2200
2201 CHARACTER(LEN=*), INTENT(IN) :: element_symbol
2202 TYPE(atom_basis_type), INTENT(INOUT) :: basis
2203 CHARACTER(LEN=*), INTENT(IN) :: basis_set_name, basis_set_file
2204 TYPE(section_vals_type), POINTER :: basis_section
2205
2206 INTEGER, PARAMETER :: maxpri = 40, maxset = 20
2207
2208 CHARACTER(len=20*default_string_length) :: line_att
2209 CHARACTER(LEN=240) :: line
2210 CHARACTER(LEN=242) :: line2
2211 CHARACTER(LEN=LEN(basis_set_name)) :: bsname
2212 CHARACTER(LEN=LEN(basis_set_name)+2) :: bsname2
2213 CHARACTER(LEN=LEN(element_symbol)) :: symbol
2214 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
2215 INTEGER :: i, ii, ipgf, irep, iset, ishell, j, k, &
2216 lshell, nj, nmin, ns, nset, strlen1, &
2217 strlen2
2218 INTEGER, DIMENSION(maxpri, maxset) :: l
2219 INTEGER, DIMENSION(maxset) :: lmax, lmin, n, npgf, nshell
2220 LOGICAL :: found, is_ok, match, read_from_input
2221 REAL(dp) :: expzet, gcca, prefac, zeta
2222 REAL(dp), DIMENSION(maxpri, maxpri, maxset) :: gcc
2223 REAL(dp), DIMENSION(maxpri, maxset) :: zet
2224 TYPE(cp_sll_val_type), POINTER :: list
2225 TYPE(val_type), POINTER :: val
2226
2227 bsname = basis_set_name
2228 symbol = element_symbol
2229 irep = 0
2230
2231 nset = 0
2232 lmin = 0
2233 lmax = 0
2234 npgf = 0
2235 n = 0
2236 l = 0
2237 zet = 0._dp
2238 gcc = 0._dp
2239
2240 read_from_input = .false.
2241 CALL section_vals_get(basis_section, explicit=read_from_input)
2242 IF (read_from_input) THEN
2243 NULLIFY (list, val)
2244 CALL section_vals_list_get(basis_section, "_DEFAULT_KEYWORD_", list=list)
2245 CALL uppercase(symbol)
2246 CALL uppercase(bsname)
2247 is_ok = cp_sll_val_next(list, val)
2248 cpassert(is_ok)
2249 CALL val_get(val, c_val=line_att)
2250 READ (line_att, *) nset
2251 cpassert(nset <= maxset)
2252 DO iset = 1, nset
2253 is_ok = cp_sll_val_next(list, val)
2254 cpassert(is_ok)
2255 CALL val_get(val, c_val=line_att)
2256 READ (line_att, *) n(iset)
2257 CALL remove_word(line_att)
2258 READ (line_att, *) lmin(iset)
2259 CALL remove_word(line_att)
2260 READ (line_att, *) lmax(iset)
2261 CALL remove_word(line_att)
2262 READ (line_att, *) npgf(iset)
2263 CALL remove_word(line_att)
2264 cpassert(npgf(iset) <= maxpri)
2265 nshell(iset) = 0
2266 DO lshell = lmin(iset), lmax(iset)
2267 nmin = n(iset) + lshell - lmin(iset)
2268 READ (line_att, *) ishell
2269 CALL remove_word(line_att)
2270 nshell(iset) = nshell(iset) + ishell
2271 DO i = 1, ishell
2272 l(nshell(iset) - ishell + i, iset) = lshell
2273 END DO
2274 END DO
2275 cpassert(len_trim(line_att) == 0)
2276 DO ipgf = 1, npgf(iset)
2277 is_ok = cp_sll_val_next(list, val)
2278 cpassert(is_ok)
2279 CALL val_get(val, c_val=line_att)
2280 READ (line_att, *) zet(ipgf, iset), (gcc(ipgf, ishell, iset), ishell=1, nshell(iset))
2281 END DO
2282 END DO
2283 ELSE
2284 block
2285 TYPE(cp_parser_type) :: parser
2286 CALL parser_create(parser, basis_set_file)
2287 ! Search for the requested basis set in the basis set file
2288 ! until the basis set is found or the end of file is reached
2289 search_loop: DO
2290 CALL parser_search_string(parser, trim(bsname), .true., found, line)
2291 IF (found) THEN
2292 CALL uppercase(symbol)
2293 CALL uppercase(bsname)
2294 match = .false.
2295 CALL uppercase(line)
2296 ! Check both the element symbol and the basis set name
2297 line2 = " "//line//" "
2298 symbol2 = " "//trim(symbol)//" "
2299 bsname2 = " "//trim(bsname)//" "
2300 strlen1 = len_trim(symbol2) + 1
2301 strlen2 = len_trim(bsname2) + 1
2302
2303 IF ((index(line2, symbol2(:strlen1)) > 0) .AND. &
2304 (index(line2, bsname2(:strlen2)) > 0)) match = .true.
2305
2306 IF (match) THEN
2307 ! Read the basis set information
2308 CALL parser_get_object(parser, nset, newline=.true.)
2309 cpassert(nset <= maxset)
2310 DO iset = 1, nset
2311 CALL parser_get_object(parser, n(iset), newline=.true.)
2312 CALL parser_get_object(parser, lmin(iset))
2313 CALL parser_get_object(parser, lmax(iset))
2314 CALL parser_get_object(parser, npgf(iset))
2315 cpassert(npgf(iset) <= maxpri)
2316 nshell(iset) = 0
2317 DO lshell = lmin(iset), lmax(iset)
2318 nmin = n(iset) + lshell - lmin(iset)
2319 CALL parser_get_object(parser, ishell)
2320 nshell(iset) = nshell(iset) + ishell
2321 DO i = 1, ishell
2322 l(nshell(iset) - ishell + i, iset) = lshell
2323 END DO
2324 END DO
2325 DO ipgf = 1, npgf(iset)
2326 CALL parser_get_object(parser, zet(ipgf, iset), newline=.true.)
2327 DO ishell = 1, nshell(iset)
2328 CALL parser_get_object(parser, gcc(ipgf, ishell, iset))
2329 END DO
2330 END DO
2331 END DO
2332
2333 EXIT search_loop
2334
2335 END IF
2336 ELSE
2337 ! Stop program, if the end of file is reached
2338 cpabort("")
2339 END IF
2340
2341 END DO search_loop
2342
2343 CALL parser_release(parser)
2344 END block
2345 END IF
2346
2347 ! fill in the basis data structures
2348 basis%nprim = 0
2349 basis%nbas = 0
2350 DO i = 1, nset
2351 DO j = lmin(i), min(lmax(i), lmat)
2352 basis%nprim(j) = basis%nprim(j) + npgf(i)
2353 END DO
2354 DO j = 1, nshell(i)
2355 k = l(j, i)
2356 IF (k <= lmat) basis%nbas(k) = basis%nbas(k) + 1
2357 END DO
2358 END DO
2359
2360 nj = maxval(basis%nprim)
2361 ns = maxval(basis%nbas)
2362 ALLOCATE (basis%am(nj, 0:lmat))
2363 basis%am = 0._dp
2364 ALLOCATE (basis%cm(nj, ns, 0:lmat))
2365 basis%cm = 0._dp
2366
2367 DO j = 0, lmat
2368 nj = 0
2369 ns = 0
2370 DO i = 1, nset
2371 IF (j >= lmin(i) .AND. j <= lmax(i)) THEN
2372 DO ipgf = 1, npgf(i)
2373 basis%am(nj + ipgf, j) = zet(ipgf, i)
2374 END DO
2375 DO ii = 1, nshell(i)
2376 IF (l(ii, i) == j) THEN
2377 ns = ns + 1
2378 DO ipgf = 1, npgf(i)
2379 basis%cm(nj + ipgf, ns, j) = gcc(ipgf, ii, i)
2380 END DO
2381 END IF
2382 END DO
2383 nj = nj + npgf(i)
2384 END IF
2385 END DO
2386 END DO
2387
2388 ! Normalization
2389 DO j = 0, lmat
2390 expzet = 0.25_dp*real(2*j + 3, dp)
2391 prefac = sqrt(rootpi/2._dp**(j + 2)*dfac(2*j + 1))
2392 DO ipgf = 1, basis%nprim(j)
2393 DO ii = 1, basis%nbas(j)
2394 gcca = basis%cm(ipgf, ii, j)
2395 zeta = 2._dp*basis%am(ipgf, j)
2396 basis%cm(ipgf, ii, j) = zeta**expzet*gcca/prefac
2397 END DO
2398 END DO
2399 END DO
2400
2401 END SUBROUTINE read_basis_set
2402
2403! **************************************************************************************************
2404!> \brief ...
2405!> \param optimization ...
2406!> \param opt_section ...
2407! **************************************************************************************************
2408 SUBROUTINE read_atom_opt_section(optimization, opt_section)
2409 TYPE(atom_optimization_type), INTENT(INOUT) :: optimization
2410 TYPE(section_vals_type), POINTER :: opt_section
2411
2412 INTEGER :: miter, ndiis
2413 REAL(kind=dp) :: damp, eps_diis, eps_scf
2414
2415 CALL section_vals_val_get(opt_section, "MAX_ITER", i_val=miter)
2416 CALL section_vals_val_get(opt_section, "EPS_SCF", r_val=eps_scf)
2417 CALL section_vals_val_get(opt_section, "N_DIIS", i_val=ndiis)
2418 CALL section_vals_val_get(opt_section, "EPS_DIIS", r_val=eps_diis)
2419 CALL section_vals_val_get(opt_section, "DAMPING", r_val=damp)
2420
2421 optimization%max_iter = miter
2422 optimization%eps_scf = eps_scf
2423 optimization%n_diis = ndiis
2424 optimization%eps_diis = eps_diis
2425 optimization%damping = damp
2426
2427 END SUBROUTINE read_atom_opt_section
2428! **************************************************************************************************
2429!> \brief ...
2430!> \param potential ...
2431!> \param potential_section ...
2432!> \param zval ...
2433! **************************************************************************************************
2434 SUBROUTINE init_atom_potential(potential, potential_section, zval)
2435 TYPE(atom_potential_type), INTENT(INOUT) :: potential
2436 TYPE(section_vals_type), POINTER :: potential_section
2437 INTEGER, INTENT(IN) :: zval
2438
2439 CHARACTER(LEN=default_string_length) :: pseudo_fn, pseudo_name
2440 INTEGER :: ic
2441 REAL(dp), DIMENSION(:), POINTER :: convals
2442 TYPE(section_vals_type), POINTER :: ecp_potential_section, &
2443 gth_potential_section
2444
2445 IF (zval > 0) THEN
2446 CALL section_vals_val_get(potential_section, "PSEUDO_TYPE", i_val=potential%ppot_type)
2447
2448 SELECT CASE (potential%ppot_type)
2449 CASE (gth_pseudo)
2450 CALL section_vals_val_get(potential_section, "POTENTIAL_FILE_NAME", c_val=pseudo_fn)
2451 CALL section_vals_val_get(potential_section, "POTENTIAL_NAME", c_val=pseudo_name)
2452 gth_potential_section => section_vals_get_subs_vals(potential_section, "GTH_POTENTIAL")
2453 CALL read_gth_potential(ptable(zval)%symbol, potential%gth_pot, &
2454 pseudo_name, pseudo_fn, gth_potential_section)
2455 CASE (ecp_pseudo)
2456 CALL section_vals_val_get(potential_section, "POTENTIAL_FILE_NAME", c_val=pseudo_fn)
2457 CALL section_vals_val_get(potential_section, "POTENTIAL_NAME", c_val=pseudo_name)
2458 ecp_potential_section => section_vals_get_subs_vals(potential_section, "ECP")
2459 CALL read_ecp_potential(ptable(zval)%symbol, potential%ecp_pot, &
2460 pseudo_name, pseudo_fn, ecp_potential_section)
2461 CASE (upf_pseudo)
2462 CALL section_vals_val_get(potential_section, "POTENTIAL_FILE_NAME", c_val=pseudo_fn)
2463 CALL section_vals_val_get(potential_section, "POTENTIAL_NAME", c_val=pseudo_name)
2464 CALL atom_read_upf(potential%upf_pot, pseudo_fn)
2465 potential%upf_pot%pname = pseudo_name
2466 CASE (sgp_pseudo)
2467 cpabort("Not implemented")
2468 CASE (no_pseudo)
2469 ! do nothing
2470 CASE DEFAULT
2471 cpabort("")
2472 END SELECT
2473 ELSE
2474 potential%ppot_type = no_pseudo
2475 END IF
2476
2477 ! confinement
2478 NULLIFY (convals)
2479 CALL section_vals_val_get(potential_section, "CONFINEMENT_TYPE", i_val=ic)
2480 potential%conf_type = ic
2481 IF (potential%conf_type == no_conf) THEN
2482 potential%acon = 0.0_dp
2483 potential%rcon = 4.0_dp
2484 potential%scon = 2.0_dp
2485 potential%confinement = .false.
2486 ELSE IF (potential%conf_type == poly_conf) THEN
2487 CALL section_vals_val_get(potential_section, "CONFINEMENT", r_vals=convals)
2488 IF (SIZE(convals) >= 1) THEN
2489 IF (convals(1) > 0.0_dp) THEN
2490 potential%confinement = .true.
2491 potential%acon = convals(1)
2492 IF (SIZE(convals) >= 2) THEN
2493 potential%rcon = convals(2)
2494 ELSE
2495 potential%rcon = 4.0_dp
2496 END IF
2497 IF (SIZE(convals) >= 3) THEN
2498 potential%scon = convals(3)
2499 ELSE
2500 potential%scon = 2.0_dp
2501 END IF
2502 ELSE
2503 potential%confinement = .false.
2504 END IF
2505 ELSE
2506 potential%confinement = .false.
2507 END IF
2508 ELSE IF (potential%conf_type == barrier_conf) THEN
2509 potential%acon = 200.0_dp
2510 potential%rcon = 4.0_dp
2511 potential%scon = 12.0_dp
2512 potential%confinement = .true.
2513 CALL section_vals_val_get(potential_section, "CONFINEMENT", r_vals=convals)
2514 IF (SIZE(convals) >= 1) THEN
2515 IF (convals(1) > 0.0_dp) THEN
2516 potential%acon = convals(1)
2517 IF (SIZE(convals) >= 2) THEN
2518 potential%rcon = convals(2)
2519 END IF
2520 IF (SIZE(convals) >= 3) THEN
2521 potential%scon = convals(3)
2522 END IF
2523 ELSE
2524 potential%confinement = .false.
2525 END IF
2526 END IF
2527 END IF
2528
2529 END SUBROUTINE init_atom_potential
2530! **************************************************************************************************
2531!> \brief ...
2532!> \param potential ...
2533! **************************************************************************************************
2534 SUBROUTINE release_atom_potential(potential)
2535 TYPE(atom_potential_type), INTENT(INOUT) :: potential
2536
2537 potential%confinement = .false.
2538
2539 CALL atom_release_upf(potential%upf_pot)
2540
2541 END SUBROUTINE release_atom_potential
2542! **************************************************************************************************
2543!> \brief ...
2544!> \param element_symbol ...
2545!> \param potential ...
2546!> \param pseudo_name ...
2547!> \param pseudo_file ...
2548!> \param potential_section ...
2549! **************************************************************************************************
2550 SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_file, &
2551 potential_section)
2552
2553 CHARACTER(LEN=*), INTENT(IN) :: element_symbol
2554 TYPE(atom_gthpot_type), INTENT(INOUT) :: potential
2555 CHARACTER(LEN=*), INTENT(IN) :: pseudo_name, pseudo_file
2556 TYPE(section_vals_type), POINTER :: potential_section
2557
2558 CHARACTER(LEN=240) :: line
2559 CHARACTER(LEN=242) :: line2
2560 CHARACTER(len=5*default_string_length) :: line_att
2561 CHARACTER(LEN=LEN(element_symbol)) :: symbol
2562 CHARACTER(LEN=LEN(element_symbol)+2) :: symbol2
2563 CHARACTER(LEN=LEN(pseudo_name)) :: apname
2564 CHARACTER(LEN=LEN(pseudo_name)+2) :: apname2
2565 INTEGER :: i, ic, ipot, j, l, nlmax, strlen1, &
2566 strlen2
2567 INTEGER, DIMENSION(0:lmat) :: elec_conf
2568 LOGICAL :: found, is_ok, match, read_from_input
2569 TYPE(cp_sll_val_type), POINTER :: list
2570 TYPE(val_type), POINTER :: val
2571
2572 elec_conf = 0
2573
2574 apname = pseudo_name
2575 symbol = element_symbol
2576
2577 potential%symbol = symbol
2578 potential%pname = apname
2579 potential%econf = 0
2580 potential%rc = 0._dp
2581 potential%ncl = 0
2582 potential%cl = 0._dp
2583 potential%nl = 0
2584 potential%rcnl = 0._dp
2585 potential%hnl = 0._dp
2586 potential%soc = .false.
2587 potential%knl = 0._dp
2588
2589 potential%lpotextended = .false.
2590 potential%lsdpot = .false.
2591 potential%nlcc = .false.
2592 potential%nexp_lpot = 0
2593 potential%nexp_lsd = 0
2594 potential%nexp_nlcc = 0
2595
2596 read_from_input = .false.
2597 CALL section_vals_get(potential_section, explicit=read_from_input)
2598 IF (read_from_input) THEN
2599 CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
2600 CALL uppercase(symbol)
2601 CALL uppercase(apname)
2602 ! Read the electronic configuration, not used here
2603 l = 0
2604 is_ok = cp_sll_val_next(list, val)
2605 cpassert(is_ok)
2606 CALL val_get(val, c_val=line_att)
2607 READ (line_att, *) elec_conf(l)
2608 CALL remove_word(line_att)
2609 DO WHILE (len_trim(line_att) /= 0)
2610 l = l + 1
2611 READ (line_att, *) elec_conf(l)
2612 CALL remove_word(line_att)
2613 END DO
2614 potential%econf(0:lmat) = elec_conf(0:lmat)
2615 potential%zion = real(sum(elec_conf), dp)
2616 ! Read r(loc) to define the exponent of the core charge
2617 is_ok = cp_sll_val_next(list, val)
2618 cpassert(is_ok)
2619 CALL val_get(val, c_val=line_att)
2620 READ (line_att, *) potential%rc
2621 CALL remove_word(line_att)
2622 ! Read the parameters for the local part of the GTH pseudopotential (ppl)
2623 READ (line_att, *) potential%ncl
2624 CALL remove_word(line_att)
2625 DO i = 1, potential%ncl
2626 READ (line_att, *) potential%cl(i)
2627 CALL remove_word(line_att)
2628 END DO
2629 ! Check for the next entry: LPOT, NLCC, LSD, or ppnl
2630 DO
2631 is_ok = cp_sll_val_next(list, val)
2632 cpassert(is_ok)
2633 CALL val_get(val, c_val=line_att)
2634 IF (index(line_att, "LPOT") /= 0) THEN
2635 potential%lpotextended = .true.
2636 CALL remove_word(line_att)
2637 READ (line_att, *) potential%nexp_lpot
2638 DO ipot = 1, potential%nexp_lpot
2639 is_ok = cp_sll_val_next(list, val)
2640 cpassert(is_ok)
2641 CALL val_get(val, c_val=line_att)
2642 READ (line_att, *) potential%alpha_lpot(ipot)
2643 CALL remove_word(line_att)
2644 READ (line_att, *) potential%nct_lpot(ipot)
2645 CALL remove_word(line_att)
2646 DO ic = 1, potential%nct_lpot(ipot)
2647 READ (line_att, *) potential%cval_lpot(ic, ipot)
2648 CALL remove_word(line_att)
2649 END DO
2650 END DO
2651 ELSEIF (index(line_att, "NLCC") /= 0) THEN
2652 potential%nlcc = .true.
2653 CALL remove_word(line_att)
2654 READ (line_att, *) potential%nexp_nlcc
2655 DO ipot = 1, potential%nexp_nlcc
2656 is_ok = cp_sll_val_next(list, val)
2657 cpassert(is_ok)
2658 CALL val_get(val, c_val=line_att)
2659 READ (line_att, *) potential%alpha_nlcc(ipot)
2660 CALL remove_word(line_att)
2661 READ (line_att, *) potential%nct_nlcc(ipot)
2662 CALL remove_word(line_att)
2663 DO ic = 1, potential%nct_nlcc(ipot)
2664 READ (line_att, *) potential%cval_nlcc(ic, ipot)
2665 !make cp2k compatible with bigdft
2666 potential%cval_nlcc(ic, ipot) = potential%cval_nlcc(ic, ipot)/(4.0_dp*pi)
2667 CALL remove_word(line_att)
2668 END DO
2669 END DO
2670 ELSEIF (index(line_att, "LSD") /= 0) THEN
2671 potential%lsdpot = .true.
2672 CALL remove_word(line_att)
2673 READ (line_att, *) potential%nexp_lsd
2674 DO ipot = 1, potential%nexp_lsd
2675 is_ok = cp_sll_val_next(list, val)
2676 cpassert(is_ok)
2677 CALL val_get(val, c_val=line_att)
2678 READ (line_att, *) potential%alpha_lsd(ipot)
2679 CALL remove_word(line_att)
2680 READ (line_att, *) potential%nct_lsd(ipot)
2681 CALL remove_word(line_att)
2682 DO ic = 1, potential%nct_lsd(ipot)
2683 READ (line_att, *) potential%cval_lsd(ic, ipot)
2684 CALL remove_word(line_att)
2685 END DO
2686 END DO
2687 ELSE
2688 EXIT
2689 END IF
2690 END DO
2691 ! Read the parameters for the non-local part of the GTH pseudopotential (ppnl)
2692 READ (line_att, *) nlmax
2693 CALL remove_word(line_att)
2694 IF (index(line_att, "SOC") /= 0) potential%soc = .true.
2695 IF (nlmax > 0) THEN
2696 ! Load the parameter for nlmax non-local projectors
2697 DO l = 0, nlmax - 1
2698 is_ok = cp_sll_val_next(list, val)
2699 cpassert(is_ok)
2700 CALL val_get(val, c_val=line_att)
2701 READ (line_att, *) potential%rcnl(l)
2702 CALL remove_word(line_att)
2703 READ (line_att, *) potential%nl(l)
2704 CALL remove_word(line_att)
2705 DO i = 1, potential%nl(l)
2706 IF (i == 1) THEN
2707 READ (line_att, *) potential%hnl(1, 1, l)
2708 CALL remove_word(line_att)
2709 ELSE
2710 cpassert(len_trim(line_att) == 0)
2711 is_ok = cp_sll_val_next(list, val)
2712 cpassert(is_ok)
2713 CALL val_get(val, c_val=line_att)
2714 READ (line_att, *) potential%hnl(i, i, l)
2715 CALL remove_word(line_att)
2716 END IF
2717 DO j = i + 1, potential%nl(l)
2718 READ (line_att, *) potential%hnl(i, j, l)
2719 potential%hnl(j, i, l) = potential%hnl(i, j, l)
2720 CALL remove_word(line_att)
2721 END DO
2722 END DO
2723 IF (potential%soc .AND. l /= 0) THEN
2724 is_ok = cp_sll_val_next(list, val)
2725 cpassert(is_ok)
2726 CALL val_get(val, c_val=line_att)
2727 DO i = 1, potential%nl(l)
2728 IF (i == 1) THEN
2729 READ (line_att, *) potential%knl(1, 1, l)
2730 CALL remove_word(line_att)
2731 ELSE
2732 cpassert(len_trim(line_att) == 0)
2733 is_ok = cp_sll_val_next(list, val)
2734 cpassert(is_ok)
2735 CALL val_get(val, c_val=line_att)
2736 READ (line_att, *) potential%knl(i, i, l)
2737 CALL remove_word(line_att)
2738 END IF
2739 DO j = i + 1, potential%nl(l)
2740 READ (line_att, *) potential%knl(i, j, l)
2741 potential%knl(j, i, l) = potential%knl(i, j, l)
2742 CALL remove_word(line_att)
2743 END DO
2744 END DO
2745 END IF
2746 cpassert(len_trim(line_att) == 0)
2747 END DO
2748 END IF
2749 ELSE
2750 block
2751 TYPE(cp_parser_type) :: parser
2752 CALL parser_create(parser, pseudo_file)
2753
2754 search_loop: DO
2755 CALL parser_search_string(parser, trim(apname), .true., found, line)
2756 IF (found) THEN
2757 CALL uppercase(symbol)
2758 CALL uppercase(apname)
2759 ! Check both the element symbol and the atomic potential name
2760 match = .false.
2761 CALL uppercase(line)
2762 line2 = " "//line//" "
2763 symbol2 = " "//trim(symbol)//" "
2764 apname2 = " "//trim(apname)//" "
2765 strlen1 = len_trim(symbol2) + 1
2766 strlen2 = len_trim(apname2) + 1
2767
2768 IF ((index(line2, symbol2(:strlen1)) > 0) .AND. &
2769 (index(line2, apname2(:strlen2)) > 0)) match = .true.
2770
2771 IF (match) THEN
2772 ! Read the electronic configuration
2773 l = 0
2774 CALL parser_get_object(parser, elec_conf(l), newline=.true.)
2775 DO WHILE (parser_test_next_token(parser) == "INT")
2776 l = l + 1
2777 CALL parser_get_object(parser, elec_conf(l))
2778 END DO
2779 potential%econf(0:lmat) = elec_conf(0:lmat)
2780 potential%zion = real(sum(elec_conf), dp)
2781 ! Read r(loc) to define the exponent of the core charge
2782 CALL parser_get_object(parser, potential%rc, newline=.true.)
2783 ! Read the parameters for the local part of the GTH pseudopotential (ppl)
2784 CALL parser_get_object(parser, potential%ncl)
2785 DO i = 1, potential%ncl
2786 CALL parser_get_object(parser, potential%cl(i))
2787 END DO
2788 ! Extended type input
2789 DO
2790 CALL parser_get_next_line(parser, 1)
2791 IF (parser_test_next_token(parser) == "INT") THEN
2792 EXIT
2793 ELSEIF (parser_test_next_token(parser) == "STR") THEN
2794 CALL parser_get_object(parser, line)
2795 IF (index(line, "LPOT") /= 0) THEN
2796 ! local potential
2797 potential%lpotextended = .true.
2798 CALL parser_get_object(parser, potential%nexp_lpot)
2799 DO ipot = 1, potential%nexp_lpot
2800 CALL parser_get_object(parser, potential%alpha_lpot(ipot), newline=.true.)
2801 CALL parser_get_object(parser, potential%nct_lpot(ipot))
2802 DO ic = 1, potential%nct_lpot(ipot)
2803 CALL parser_get_object(parser, potential%cval_lpot(ic, ipot))
2804 END DO
2805 END DO
2806 ELSEIF (index(line, "NLCC") /= 0) THEN
2807 ! NLCC
2808 potential%nlcc = .true.
2809 CALL parser_get_object(parser, potential%nexp_nlcc)
2810 DO ipot = 1, potential%nexp_nlcc
2811 CALL parser_get_object(parser, potential%alpha_nlcc(ipot), newline=.true.)
2812 CALL parser_get_object(parser, potential%nct_nlcc(ipot))
2813 DO ic = 1, potential%nct_nlcc(ipot)
2814 CALL parser_get_object(parser, potential%cval_nlcc(ic, ipot))
2815 !make cp2k compatible with bigdft
2816 potential%cval_nlcc(ic, ipot) = potential%cval_nlcc(ic, ipot)/(4.0_dp*pi)
2817 END DO
2818 END DO
2819 ELSEIF (index(line, "LSD") /= 0) THEN
2820 ! LSD potential
2821 potential%lsdpot = .true.
2822 CALL parser_get_object(parser, potential%nexp_lsd)
2823 DO ipot = 1, potential%nexp_lsd
2824 CALL parser_get_object(parser, potential%alpha_lsd(ipot), newline=.true.)
2825 CALL parser_get_object(parser, potential%nct_lsd(ipot))
2826 DO ic = 1, potential%nct_lsd(ipot)
2827 CALL parser_get_object(parser, potential%cval_lsd(ic, ipot))
2828 END DO
2829 END DO
2830 ELSE
2831 cpabort("")
2832 END IF
2833 ELSE
2834 cpabort("")
2835 END IF
2836 END DO
2837 ! Read the parameters for the non-local part of the GTH pseudopotential (ppnl)
2838 CALL parser_get_object(parser, nlmax)
2839 IF (nlmax > 0) THEN
2840 IF (parser_test_next_token(parser) == "STR") THEN
2841 CALL parser_get_object(parser, line)
2842 IF (index(line, "SOC") /= 0) potential%soc = .true.
2843 END IF
2844 ! Load the parameter for n non-local projectors
2845 DO l = 0, nlmax - 1
2846 CALL parser_get_object(parser, potential%rcnl(l), newline=.true.)
2847 CALL parser_get_object(parser, potential%nl(l))
2848 DO i = 1, potential%nl(l)
2849 IF (i == 1) THEN
2850 CALL parser_get_object(parser, potential%hnl(i, i, l))
2851 ELSE
2852 CALL parser_get_object(parser, potential%hnl(i, i, l), newline=.true.)
2853 END IF
2854 DO j = i + 1, potential%nl(l)
2855 CALL parser_get_object(parser, potential%hnl(i, j, l))
2856 potential%hnl(j, i, l) = potential%hnl(i, j, l)
2857 END DO
2858 END DO
2859 IF (potential%soc .AND. l /= 0) THEN
2860 DO i = 1, potential%nl(l)
2861 CALL parser_get_object(parser, potential%knl(i, i, l), newline=.true.)
2862 DO j = i + 1, potential%nl(l)
2863 CALL parser_get_object(parser, potential%knl(i, j, l))
2864 potential%knl(j, i, l) = potential%knl(i, j, l)
2865 END DO
2866 END DO
2867 END IF
2868 END DO
2869 END IF
2870 EXIT search_loop
2871 END IF
2872 ELSE
2873 ! Stop program, if the end of file is reached
2874 cpabort("")
2875 END IF
2876
2877 END DO search_loop
2878
2879 CALL parser_release(parser)
2880 END block
2881 END IF
2882
2883 END SUBROUTINE read_gth_potential
2884! **************************************************************************************************
2885!> \brief ...
2886!> \param element_symbol ...
2887!> \param potential ...
2888!> \param pseudo_name ...
2889!> \param pseudo_file ...
2890!> \param potential_section ...
2891! **************************************************************************************************
2892 SUBROUTINE read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_file, &
2893 potential_section)
2894
2895 CHARACTER(LEN=*), INTENT(IN) :: element_symbol
2896 TYPE(atom_ecppot_type), INTENT(INOUT) :: potential
2897 CHARACTER(LEN=*), INTENT(IN) :: pseudo_name, pseudo_file
2898 TYPE(section_vals_type), POINTER :: potential_section
2899
2900 CHARACTER(LEN=240) :: line
2901 CHARACTER(len=5*default_string_length) :: line_att
2902 CHARACTER(LEN=LEN(element_symbol)+1) :: symbol
2903 CHARACTER(LEN=LEN(pseudo_name)) :: apname
2904 INTEGER :: i, ic, l, ncore, nel
2905 LOGICAL :: found, is_ok, read_from_input
2906 TYPE(cp_sll_val_type), POINTER :: list
2907 TYPE(val_type), POINTER :: val
2908
2909 apname = pseudo_name
2910 symbol = element_symbol
2911 CALL get_ptable_info(symbol, number=ncore)
2912
2913 potential%symbol = symbol
2914 potential%pname = apname
2915 potential%econf = 0
2916 potential%zion = 0
2917 potential%lmax = -1
2918 potential%nloc = 0
2919 potential%nrloc = 0
2920 potential%aloc = 0.0_dp
2921 potential%bloc = 0.0_dp
2922 potential%npot = 0
2923 potential%nrpot = 0
2924 potential%apot = 0.0_dp
2925 potential%bpot = 0.0_dp
2926
2927 read_from_input = .false.
2928 CALL section_vals_get(potential_section, explicit=read_from_input)
2929 IF (read_from_input) THEN
2930 CALL section_vals_list_get(potential_section, "_DEFAULT_KEYWORD_", list=list)
2931 ! number of electrons (mandatory line)
2932 is_ok = cp_sll_val_next(list, val)
2933 cpassert(is_ok)
2934 CALL val_get(val, c_val=line_att)
2935 CALL remove_word(line_att)
2936 CALL remove_word(line_att)
2937 ! read number of electrons
2938 READ (line_att, *) nel
2939 potential%zion = real(ncore - nel, kind=dp)
2940 ! local potential (mandatory block)
2941 is_ok = cp_sll_val_next(list, val)
2942 cpassert(is_ok)
2943 CALL val_get(val, c_val=line_att)
2944 DO i = 1, 10
2945 IF (.NOT. cp_sll_val_next(list, val)) EXIT
2946 CALL val_get(val, c_val=line_att)
2947 IF (index(line_att, element_symbol) == 0) THEN
2948 potential%nloc = potential%nloc + 1
2949 ic = potential%nloc
2950 READ (line_att, *) potential%nrloc(ic), potential%bloc(ic), potential%aloc(ic)
2951 ELSE
2952 EXIT
2953 END IF
2954 END DO
2955 ! read potentials
2956 DO
2957 CALL val_get(val, c_val=line_att)
2958 IF (index(line_att, element_symbol) == 0) THEN
2959 potential%npot(l) = potential%npot(l) + 1
2960 ic = potential%npot(l)
2961 READ (line_att, *) potential%nrpot(ic, l), potential%bpot(ic, l), potential%apot(ic, l)
2962 ELSE
2963 potential%lmax = potential%lmax + 1
2964 l = potential%lmax
2965 END IF
2966 IF (.NOT. cp_sll_val_next(list, val)) EXIT
2967 END DO
2968
2969 ELSE
2970 block
2971 TYPE(cp_parser_type) :: parser
2972 CALL parser_create(parser, pseudo_file)
2973
2974 search_loop: DO
2975 CALL parser_search_string(parser, trim(apname), .true., found, line)
2976 IF (found) THEN
2977 match_loop: DO
2978 CALL parser_get_object(parser, line, newline=.true.)
2979 IF (trim(line) == element_symbol) THEN
2980 CALL parser_get_object(parser, line, lower_to_upper=.true.)
2981 cpassert(trim(line) == "NELEC")
2982 ! read number of electrons
2983 CALL parser_get_object(parser, nel)
2984 potential%zion = real(ncore - nel, kind=dp)
2985 ! read local potential flag line "<XX> ul"
2986 CALL parser_get_object(parser, line, newline=.true.)
2987 ! read local potential
2988 DO i = 1, 15
2989 CALL parser_read_line(parser, 1)
2990 IF (parser_test_next_token(parser) == "STR") EXIT
2991 potential%nloc = potential%nloc + 1
2992 ic = potential%nloc
2993 CALL parser_get_object(parser, potential%nrloc(ic))
2994 CALL parser_get_object(parser, potential%bloc(ic))
2995 CALL parser_get_object(parser, potential%aloc(ic))
2996 END DO
2997 ! read potentials (start with l loop)
2998 DO l = 0, 15
2999 CALL parser_get_object(parser, symbol)
3000 IF (symbol == element_symbol) THEN
3001 ! new l block
3002 potential%lmax = potential%lmax + 1
3003 DO i = 1, 15
3004 CALL parser_read_line(parser, 1)
3005 IF (parser_test_next_token(parser) == "STR") EXIT
3006 potential%npot(l) = potential%npot(l) + 1
3007 ic = potential%npot(l)
3008 CALL parser_get_object(parser, potential%nrpot(ic, l))
3009 CALL parser_get_object(parser, potential%bpot(ic, l))
3010 CALL parser_get_object(parser, potential%apot(ic, l))
3011 END DO
3012 ELSE
3013 EXIT
3014 END IF
3015 END DO
3016 EXIT search_loop
3017 ELSE IF (line == "END") THEN
3018 cpabort("Element not found in ECP library")
3019 END IF
3020 END DO match_loop
3021 ELSE
3022 cpabort("ECP type not found in library")
3023 END IF
3024
3025 END DO search_loop
3026
3027 CALL parser_release(parser)
3028 END block
3029 END IF
3030
3031 ! set up econf
3032 potential%econf(0:3) = ptable(ncore)%e_conv(0:3)
3033 SELECT CASE (nel)
3034 CASE DEFAULT
3035 cpabort("Unknown Core State")
3036 CASE (0)
3037 CASE (2)
3038 potential%econf(0:3) = potential%econf(0:3) - ptable(2)%e_conv(0:3)
3039 CASE (10)
3040 potential%econf(0:3) = potential%econf(0:3) - ptable(10)%e_conv(0:3)
3041 CASE (18)
3042 potential%econf(0:3) = potential%econf(0:3) - ptable(18)%e_conv(0:3)
3043 CASE (28)
3044 potential%econf(0:3) = potential%econf(0:3) - ptable(18)%e_conv(0:3)
3045 potential%econf(2) = potential%econf(2) - 10
3046 CASE (36)
3047 potential%econf(0:3) = potential%econf(0:3) - ptable(36)%e_conv(0:3)
3048 CASE (46)
3049 potential%econf(0:3) = potential%econf(0:3) - ptable(36)%e_conv(0:3)
3050 potential%econf(2) = potential%econf(2) - 10
3051 CASE (54)
3052 potential%econf(0:3) = potential%econf(0:3) - ptable(54)%e_conv(0:3)
3053 CASE (60)
3054 potential%econf(0:3) = potential%econf(0:3) - ptable(36)%e_conv(0:3)
3055 potential%econf(2) = potential%econf(2) - 10
3056 potential%econf(3) = potential%econf(3) - 14
3057 CASE (68)
3058 potential%econf(0:3) = potential%econf(0:3) - ptable(54)%e_conv(0:3)
3059 potential%econf(3) = potential%econf(3) - 14
3060 CASE (78)
3061 potential%econf(0:3) = potential%econf(0:3) - ptable(54)%e_conv(0:3)
3062 potential%econf(2) = potential%econf(2) - 10
3063 potential%econf(3) = potential%econf(3) - 14
3064 END SELECT
3065 !
3066 cpassert(all(potential%econf >= 0))
3067
3068 END SUBROUTINE read_ecp_potential
3069! **************************************************************************************************
3070!> \brief ...
3071!> \param grid1 ...
3072!> \param grid2 ...
3073!> \return ...
3074! **************************************************************************************************
3075 FUNCTION atom_compare_grids(grid1, grid2) RESULT(is_equal)
3076 TYPE(grid_atom_type) :: grid1, grid2
3077 LOGICAL :: is_equal
3078
3079 INTEGER :: i
3080 REAL(kind=dp) :: dr, dw
3081
3082 is_equal = .true.
3083 IF (grid1%nr == grid2%nr) THEN
3084 DO i = 1, grid2%nr
3085 dr = abs(grid1%rad(i) - grid2%rad(i))
3086 dw = abs(grid1%wr(i) - grid2%wr(i))
3087 IF (dr + dw > 1.0e-12_dp) THEN
3088 is_equal = .false.
3089 EXIT
3090 END IF
3091 END DO
3092 ELSE
3093 is_equal = .false.
3094 END IF
3095
3096 END FUNCTION atom_compare_grids
3097! **************************************************************************************************
3098
3099END MODULE atom_types
Define the atom type and its sub types.
Definition atom_types.F:15
integer, parameter, public num_basis
Definition atom_types.F:69
subroutine, public read_atom_opt_section(optimization, opt_section)
...
subroutine, public create_atom_type(atom)
...
Definition atom_types.F:958
integer, parameter, public cgto_basis
Definition atom_types.F:69
integer, parameter, public gto_basis
Definition atom_types.F:69
integer, parameter, public sto_basis
Definition atom_types.F:69
subroutine, public release_atom_type(atom)
...
Definition atom_types.F:982
subroutine, public release_opmat(opmat)
...
subroutine, public release_atom_potential(potential)
...
subroutine, public init_atom_basis(basis, basis_section, zval, btyp)
Initialize the basis for the atomic code.
Definition atom_types.F:378
logical function, public atom_compare_grids(grid1, grid2)
...
subroutine, public release_opgrid(opgrid)
...
subroutine, public release_atom_orbs(orbs)
...
integer, parameter, public lmat
Definition atom_types.F:67
subroutine, public set_atom(atom, basis, state, integrals, orbitals, potential, zcore, pp_calc, do_zmp, doread, read_vxc, method_type, relativistic, coulomb_integral_type, exchange_integral_type, fmat)
...
subroutine, public init_atom_potential(potential, potential_section, zval)
...
subroutine, public release_atom_basis(basis)
...
Definition atom_types.F:924
subroutine, public create_atom_orbs(orbs, mbas, mo)
...
subroutine, public init_atom_basis_default_pp(basis)
...
Definition atom_types.F:715
subroutine, public create_opmat(opmat, n, lmax)
...
subroutine, public atom_basis_gridrep(basis, gbasis, r, rab)
...
Definition atom_types.F:792
subroutine, public read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_file, potential_section)
...
subroutine, public setup_hf_section(hf_frac, do_hfx, atom, xc_section, extype)
...
subroutine, public clementi_geobas(zval, cval, aval, ngto, ival)
...
subroutine, public create_opgrid(opgrid, grid)
...
Routines that process Quantum Espresso UPF files.
Definition atom_upf.F:14
subroutine, public atom_read_upf(pot, upf_filename, read_header)
...
Definition atom_upf.F:102
pure subroutine, public atom_release_upf(upfpot)
...
Definition atom_upf.F:875
Definition atom.F:9
Calculates Bessel functions.
Definition bessel_lib.F:16
elemental impure real(kind=dp) function, public bessel0(x, l)
...
Definition bessel_lib.F:161
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public limpanuparb2011
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...
Utility routines to read data from files. Kept as close as possible to the old parser because.
subroutine, public parser_read_line(parser, nline, at_end)
Read the next line from a logical unit "unit" (I/O node only). Skip (nline-1) lines and skip also all...
subroutine, public parser_get_next_line(parser, nline, at_end)
Read the next input line and broadcast the input information. Skip (nline-1) lines and skip also all ...
character(len=3) function, public parser_test_next_token(parser, string_length)
Test next input object.
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 ...
Utility routines to read data from files. Kept as close as possible to the old parser because.
subroutine, public parser_release(parser)
releases the parser
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.
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public do_rks_atom
integer, parameter, public do_analytic
integer, parameter, public sgp_pseudo
integer, parameter, public gth_pseudo
integer, parameter, public ecp_pseudo
integer, parameter, public do_nonrel_atom
integer, parameter, public no_conf
integer, parameter, public do_potential_mix_cl
integer, parameter, public upf_pseudo
integer, parameter, public contracted_gto
integer, parameter, public poly_conf
integer, parameter, public no_pseudo
integer, parameter, public barrier_conf
integer, parameter, public do_numeric
integer, parameter, public do_gapw_log
integer, parameter, public do_potential_coulomb
integer, parameter, public gaussian
integer, parameter, public do_potential_short
integer, parameter, public do_semi_analytic
integer, parameter, public geometrical_gto
integer, parameter, public do_potential_long
integer, parameter, public numerical
integer, parameter, public slater
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_vals_list_get(section_vals, keyword_name, i_rep_section, list)
returns the requested list
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
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
a wrapper for basic fortran types.
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
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
real(kind=dp), dimension(-1:2 *maxfac+1), parameter, public dfac
real(kind=dp), parameter, public rootpi
real(kind=dp), dimension(0:maxfac), parameter, public fac
Periodic Table related data definitions.
type(atom), dimension(0:nelem), public ptable
subroutine, public get_ptable_info(symbol, number, amass, ielement, covalent_radius, metallic_radius, vdw_radius, found)
Pass information about the kind given the element symbol.
subroutine, public deallocate_grid_atom(grid_atom)
Deallocate a Gaussian-type orbital (GTO) basis set data set.
subroutine, public allocate_grid_atom(grid_atom)
Initialize components of the grid_atom_type structure.
subroutine, public create_grid_atom(grid_atom, nr, na, llmax, ll, quadrature)
...
Utilities for string manipulations.
character(len=1), parameter, public newline
subroutine, public remove_word(string)
remove a word from a string (words are separated by white spaces)
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Provides all information about a basis set.
Definition atom_types.F:78
Provides all information about a pseudopotential.
Definition atom_types.F:98
Provides info about hartree-fock exchange (For now, we only support potentials that can be represente...
Definition atom_types.F:187
Information on optimization procedure.
Definition atom_types.F:283
Holds atomic orbitals and energies.
Definition atom_types.F:237
Provides all information on states and occupation.
Definition atom_types.F:198
Provides all information about an atomic kind.
Definition atom_types.F:293
Holds atomic integrals.
Definition atom_types.F:212
Operator grids.
Definition atom_types.F:258
Operator matrices.
Definition atom_types.F:251
represent a single linked list that stores pointers to the elements
a type to have a wrapper that stores any basic fortran type