(git:ed6f26b)
Loading...
Searching...
No Matches
aux_basis_set.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!> \par History
10!> none
11!> \author JGH (11.2017)
12! **************************************************************************************************
13MODULE aux_basis_set
14
15 USE basis_set_types, ONLY: gto_basis_set_type
16 USE kinds, ONLY: default_string_length,&
17 dp
18 USE orbital_pointers, ONLY: indco,&
19 nco,&
20 ncoset,&
21 nso
22 USE orbital_symbols, ONLY: cgf_symbol,&
23 sgf_symbol
24#include "../base/base_uses.f90"
25
26 IMPLICIT NONE
27
28 PRIVATE
29
30! *** Global parameters (only in this module)
31
32 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'aux_basis_set'
33
34! *** Public subroutines ***
35
36 PUBLIC :: create_aux_basis
37
38CONTAINS
39
40! **************************************************************************************************
41!> \brief create a basis in GTO form
42!> \param aux_basis ...
43!> \param bsname ...
44!> \param nsets ...
45!> \param lmin ...
46!> \param lmax ...
47!> \param nl ...
48!> \param npgf ...
49!> \param zet ...
50!> \version 1.0
51! **************************************************************************************************
52 SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet)
53
54 TYPE(gto_basis_set_type), POINTER :: aux_basis
55 CHARACTER(LEN=default_string_length) :: bsname
56 INTEGER, INTENT(IN) :: nsets
57 INTEGER, DIMENSION(:), INTENT(IN) :: lmin, lmax
58 INTEGER, DIMENSION(0:, :), INTENT(IN) :: nl
59 INTEGER, DIMENSION(:), INTENT(IN) :: npgf
60 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: zet
61
62 INTEGER :: i, ico, info, iset, ishell, j, l, &
63 lshell, m, maxco, maxpgf, maxshell, &
64 ncgf, ns, nsgf, nx
65 REAL(kind=dp) :: za, zb, zetab
66 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: so
67
68 cpassert(.NOT. ASSOCIATED(aux_basis))
69 ALLOCATE (aux_basis)
70 !
71 aux_basis%name = bsname
72 aux_basis%aliases = bsname
73 aux_basis%nset = nsets
74 !
75 ALLOCATE (aux_basis%npgf(nsets), aux_basis%nshell(nsets), &
76 aux_basis%lmax(nsets), aux_basis%lmin(nsets))
77 aux_basis%lmax(1:nsets) = lmax(1:nsets)
78 aux_basis%lmin(1:nsets) = lmin(1:nsets)
79 aux_basis%npgf(1:nsets) = npgf(1:nsets)
80 DO iset = 1, nsets
81 aux_basis%nshell(iset) = 0
82 DO l = lmin(iset), lmax(iset)
83 aux_basis%nshell(iset) = aux_basis%nshell(iset) + nl(l, iset)
84 END DO
85 END DO
86 maxpgf = maxval(npgf(1:nsets))
87 maxshell = maxval(aux_basis%nshell(1:nsets))
88 ALLOCATE (aux_basis%zet(maxpgf, nsets))
89 aux_basis%zet(1:maxpgf, 1:nsets) = zet(1:maxpgf, 1:nsets)
90
91 ALLOCATE (aux_basis%n(maxshell, nsets))
92 ALLOCATE (aux_basis%l(maxshell, nsets))
93 ALLOCATE (aux_basis%gcc(maxpgf, maxshell, nsets))
94
95 DO iset = 1, nsets
96 ns = 0
97 DO l = lmin(iset), lmax(iset)
98 DO i = 1, nl(l, iset)
99 ns = ns + 1
100 aux_basis%l(ns, iset) = l
101 aux_basis%n(ns, iset) = l + i
102 END DO
103 END DO
104 END DO
105
106 ! contraction
107 aux_basis%gcc = 0.0_dp
108 DO iset = 1, nsets
109 ns = 0
110 DO l = lmin(iset), lmax(iset)
111 nx = aux_basis%npgf(iset)
112 ALLOCATE (so(nx, nx))
113 cpassert(nx >= nl(l, iset))
114 DO i = 1, nx
115 za = (2.0_dp*zet(i, iset))**(0.25_dp*(2*l + 3))
116 DO j = i, nx
117 zb = (2.0_dp*zet(j, iset))**(0.25_dp*(2*l + 3))
118 zetab = zet(i, iset) + zet(j, iset)
119 so(i, j) = za*zb/zetab**(l + 1.5_dp)
120 IF (i .NE. j) so(j, i) = so(i, j)
121 END DO
122 END DO
123 info = 0
124 ! upper triangular form used below
125 CALL dpotrf('U', nx, so, nx, info)
126 cpassert(info == 0)
127 CALL dtrtri('U', "N", nx, so, nx, info)
128 cpassert(info == 0)
129 DO i = ns + 1, ns + nl(l, iset)
130 DO j = 1, i - ns
131 aux_basis%gcc(j, i, iset) = so(j, i - ns)
132 END DO
133 END DO
134 IF (nl(l, iset) < nx) THEN
135 i = ns + nl(l, iset)
136 DO j = nl(l, iset) + 1, nx
137 aux_basis%gcc(j, i, iset) = 1.0_dp
138 END DO
139 END IF
140 ns = ns + nl(l, iset)
141 DEALLOCATE (so)
142 END DO
143 END DO
144
145 ! Initialise the depending aux_basis structures
146 ALLOCATE (aux_basis%first_cgf(maxshell, nsets))
147 ALLOCATE (aux_basis%first_sgf(maxshell, nsets))
148 ALLOCATE (aux_basis%last_cgf(maxshell, nsets))
149 ALLOCATE (aux_basis%last_sgf(maxshell, nsets))
150 ALLOCATE (aux_basis%ncgf_set(nsets))
151 ALLOCATE (aux_basis%nsgf_set(nsets))
152
153 maxco = 0
154 ncgf = 0
155 nsgf = 0
156 DO iset = 1, nsets
157 aux_basis%ncgf_set(iset) = 0
158 aux_basis%nsgf_set(iset) = 0
159 DO ishell = 1, aux_basis%nshell(iset)
160 lshell = aux_basis%l(ishell, iset)
161 aux_basis%first_cgf(ishell, iset) = ncgf + 1
162 ncgf = ncgf + nco(lshell)
163 aux_basis%last_cgf(ishell, iset) = ncgf
164 aux_basis%ncgf_set(iset) = &
165 aux_basis%ncgf_set(iset) + nco(lshell)
166 aux_basis%first_sgf(ishell, iset) = nsgf + 1
167 nsgf = nsgf + nso(lshell)
168 aux_basis%last_sgf(ishell, iset) = nsgf
169 aux_basis%nsgf_set(iset) = &
170 aux_basis%nsgf_set(iset) + nso(lshell)
171 END DO
172 maxco = max(maxco, npgf(iset)*ncoset(lmax(iset)))
173 END DO
174 aux_basis%ncgf = ncgf
175 aux_basis%nsgf = nsgf
176
177 ALLOCATE (aux_basis%lx(ncgf))
178 ALLOCATE (aux_basis%ly(ncgf))
179 ALLOCATE (aux_basis%lz(ncgf))
180 ALLOCATE (aux_basis%m(nsgf))
181 ALLOCATE (aux_basis%cgf_symbol(ncgf))
182 ALLOCATE (aux_basis%sgf_symbol(nsgf))
183
184 ncgf = 0
185 nsgf = 0
186
187 DO iset = 1, nsets
188 DO ishell = 1, aux_basis%nshell(iset)
189 lshell = aux_basis%l(ishell, iset)
190 DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
191 ncgf = ncgf + 1
192 aux_basis%lx(ncgf) = indco(1, ico)
193 aux_basis%ly(ncgf) = indco(2, ico)
194 aux_basis%lz(ncgf) = indco(3, ico)
195 aux_basis%cgf_symbol(ncgf) = &
196 cgf_symbol(aux_basis%n(ishell, iset), (/aux_basis%lx(ncgf), &
197 aux_basis%ly(ncgf), &
198 aux_basis%lz(ncgf)/))
199 END DO
200 DO m = -lshell, lshell
201 nsgf = nsgf + 1
202 aux_basis%m(nsgf) = m
203 aux_basis%sgf_symbol(nsgf) = &
204 sgf_symbol(aux_basis%n(ishell, iset), lshell, m)
205 END DO
206 END DO
207 END DO
208
209 ! orbital radii (initialize later)
210 aux_basis%kind_radius = 0.0_dp
211 aux_basis%short_kind_radius = 0.0_dp
212 ALLOCATE (aux_basis%set_radius(nsets))
213 ALLOCATE (aux_basis%pgf_radius(maxpgf, nsets))
214 aux_basis%set_radius = 0.0_dp
215 aux_basis%pgf_radius = 0.0_dp
216
217 ! basis transformation matrices
218 ALLOCATE (aux_basis%cphi(maxco, ncgf))
219 ALLOCATE (aux_basis%sphi(maxco, nsgf))
220 ALLOCATE (aux_basis%scon(maxco, nsgf))
221 ALLOCATE (aux_basis%norm_cgf(ncgf))
222 aux_basis%norm_type = 2
223
224 END SUBROUTINE create_aux_basis
225
226END MODULE aux_basis_set
aux_basis_set
Definition aux_basis_set.F:13
aux_basis_set::create_aux_basis
subroutine, public create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet)
create a basis in GTO form
Definition aux_basis_set.F:53
basis_set_types
Definition basis_set_types.F:15
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
orbital_pointers
Provides Cartesian and spherical orbital pointers and indices.
Definition orbital_pointers.F:15
orbital_pointers::nco
integer, dimension(:), allocatable, public nco
Definition orbital_pointers.F:42
orbital_pointers::ncoset
integer, dimension(:), allocatable, public ncoset
Definition orbital_pointers.F:42
orbital_pointers::indco
integer, dimension(:, :), allocatable, public indco
Definition orbital_pointers.F:43
orbital_pointers::nso
integer, dimension(:), allocatable, public nso
Definition orbital_pointers.F:42
orbital_symbols
orbital_symbols
Definition orbital_symbols.F:14
orbital_symbols::cgf_symbol
character(len=12) function, public cgf_symbol(n, lxyz)
Build a Cartesian orbital symbol (orbital labels for printing).
Definition orbital_symbols.F:44
orbital_symbols::sgf_symbol
character(len=6) function, public sgf_symbol(n, l, m)
Build a spherical orbital symbol (orbital labels for printing).
Definition orbital_symbols.F:107
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72