Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \par History
10 : !> none
11 : !> \author JGH (11.2017)
12 : ! **************************************************************************************************
13 : MODULE 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 lapack, ONLY: lapack_spotrf
19 : USE orbital_pointers, ONLY: indco,&
20 : nco,&
21 : ncoset,&
22 : nso
23 : USE orbital_symbols, ONLY: cgf_symbol,&
24 : sgf_symbol
25 : #include "../base/base_uses.f90"
26 :
27 : IMPLICIT NONE
28 :
29 : PRIVATE
30 :
31 : ! *** Global parameters (only in this module)
32 :
33 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'aux_basis_set'
34 :
35 : ! *** Public subroutines ***
36 :
37 : PUBLIC :: create_aux_basis
38 :
39 : CONTAINS
40 :
41 : ! **************************************************************************************************
42 : !> \brief create a basis in GTO form
43 : !> \param aux_basis ...
44 : !> \param bsname ...
45 : !> \param nsets ...
46 : !> \param lmin ...
47 : !> \param lmax ...
48 : !> \param nl ...
49 : !> \param npgf ...
50 : !> \param zet ...
51 : !> \version 1.0
52 : ! **************************************************************************************************
53 292 : SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet)
54 :
55 : TYPE(gto_basis_set_type), POINTER :: aux_basis
56 : CHARACTER(LEN=default_string_length) :: bsname
57 : INTEGER, INTENT(IN) :: nsets
58 : INTEGER, DIMENSION(:), INTENT(IN) :: lmin, lmax
59 : INTEGER, DIMENSION(0:, :), INTENT(IN) :: nl
60 : INTEGER, DIMENSION(:), INTENT(IN) :: npgf
61 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: zet
62 :
63 : INTEGER :: i, ico, info, iset, ishell, j, l, &
64 : lshell, m, maxco, maxpgf, maxshell, &
65 : ncgf, ns, nsgf, nx
66 : REAL(KIND=dp) :: za, zb, zetab
67 292 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: so
68 :
69 292 : CPASSERT(.NOT. ASSOCIATED(aux_basis))
70 292 : ALLOCATE (aux_basis)
71 : !
72 292 : aux_basis%name = bsname
73 292 : aux_basis%aliases = bsname
74 292 : aux_basis%nset = nsets
75 : !
76 : ALLOCATE (aux_basis%npgf(nsets), aux_basis%nshell(nsets), &
77 1752 : aux_basis%lmax(nsets), aux_basis%lmin(nsets))
78 1268 : aux_basis%lmax(1:nsets) = lmax(1:nsets)
79 1268 : aux_basis%lmin(1:nsets) = lmin(1:nsets)
80 1268 : aux_basis%npgf(1:nsets) = npgf(1:nsets)
81 1268 : DO iset = 1, nsets
82 976 : aux_basis%nshell(iset) = 0
83 3112 : DO l = lmin(iset), lmax(iset)
84 2820 : aux_basis%nshell(iset) = aux_basis%nshell(iset) + nl(l, iset)
85 : END DO
86 : END DO
87 1268 : maxpgf = MAXVAL(npgf(1:nsets))
88 1268 : maxshell = MAXVAL(aux_basis%nshell(1:nsets))
89 1168 : ALLOCATE (aux_basis%zet(maxpgf, nsets))
90 6214 : aux_basis%zet(1:maxpgf, 1:nsets) = zet(1:maxpgf, 1:nsets)
91 :
92 1168 : ALLOCATE (aux_basis%n(maxshell, nsets))
93 876 : ALLOCATE (aux_basis%l(maxshell, nsets))
94 1460 : ALLOCATE (aux_basis%gcc(maxpgf, maxshell, nsets))
95 :
96 1268 : DO iset = 1, nsets
97 976 : ns = 0
98 3112 : DO l = lmin(iset), lmax(iset)
99 8680 : DO i = 1, nl(l, iset)
100 5860 : ns = ns + 1
101 5860 : aux_basis%l(ns, iset) = l
102 7704 : aux_basis%n(ns, iset) = l + i
103 : END DO
104 : END DO
105 : END DO
106 :
107 : ! contraction
108 99362 : aux_basis%gcc = 0.0_dp
109 1268 : DO iset = 1, nsets
110 976 : ns = 0
111 3112 : DO l = lmin(iset), lmax(iset)
112 1844 : nx = aux_basis%npgf(iset)
113 7376 : ALLOCATE (so(nx, nx))
114 1844 : CPASSERT(nx >= nl(l, iset))
115 8568 : DO i = 1, nx
116 6724 : za = (2.0_dp*zet(i, iset))**(0.25_dp*(2*l + 3))
117 40252 : DO j = i, nx
118 31684 : zb = (2.0_dp*zet(j, iset))**(0.25_dp*(2*l + 3))
119 31684 : zetab = zet(i, iset) + zet(j, iset)
120 31684 : so(i, j) = za*zb/zetab**(l + 1.5_dp)
121 38408 : so(j, i) = so(i, j)
122 : END DO
123 : END DO
124 1844 : info = 0
125 1844 : CALL lapack_spotrf("U", nx, so, nx, info)
126 1844 : CPASSERT(info == 0)
127 1844 : CALL dtrtri("U", "N", nx, so, nx, info)
128 1844 : CPASSERT(info == 0)
129 7704 : DO i = ns + 1, ns + nl(l, iset)
130 31094 : DO j = 1, i - ns
131 29250 : aux_basis%gcc(j, i, iset) = so(j, i - ns)
132 : END DO
133 : END DO
134 1844 : IF (nl(l, iset) < nx) THEN
135 306 : i = ns + nl(l, iset)
136 1170 : DO j = nl(l, iset) + 1, nx
137 1170 : aux_basis%gcc(j, i, iset) = 1.0_dp
138 : END DO
139 : END IF
140 1844 : ns = ns + nl(l, iset)
141 2820 : DEALLOCATE (so)
142 : END DO
143 : END DO
144 :
145 : ! Initialise the depending aux_basis structures
146 876 : ALLOCATE (aux_basis%first_cgf(maxshell, nsets))
147 876 : ALLOCATE (aux_basis%first_sgf(maxshell, nsets))
148 876 : ALLOCATE (aux_basis%last_cgf(maxshell, nsets))
149 876 : ALLOCATE (aux_basis%last_sgf(maxshell, nsets))
150 584 : ALLOCATE (aux_basis%ncgf_set(nsets))
151 584 : ALLOCATE (aux_basis%nsgf_set(nsets))
152 :
153 292 : maxco = 0
154 292 : ncgf = 0
155 292 : nsgf = 0
156 1268 : DO iset = 1, nsets
157 976 : aux_basis%ncgf_set(iset) = 0
158 976 : aux_basis%nsgf_set(iset) = 0
159 6836 : DO ishell = 1, aux_basis%nshell(iset)
160 5860 : lshell = aux_basis%l(ishell, iset)
161 5860 : aux_basis%first_cgf(ishell, iset) = ncgf + 1
162 5860 : ncgf = ncgf + nco(lshell)
163 5860 : aux_basis%last_cgf(ishell, iset) = ncgf
164 : aux_basis%ncgf_set(iset) = &
165 5860 : aux_basis%ncgf_set(iset) + nco(lshell)
166 5860 : aux_basis%first_sgf(ishell, iset) = nsgf + 1
167 5860 : nsgf = nsgf + nso(lshell)
168 5860 : aux_basis%last_sgf(ishell, iset) = nsgf
169 : aux_basis%nsgf_set(iset) = &
170 6836 : aux_basis%nsgf_set(iset) + nso(lshell)
171 : END DO
172 1268 : maxco = MAX(maxco, npgf(iset)*ncoset(lmax(iset)))
173 : END DO
174 292 : aux_basis%ncgf = ncgf
175 292 : aux_basis%nsgf = nsgf
176 :
177 876 : ALLOCATE (aux_basis%lx(ncgf))
178 584 : ALLOCATE (aux_basis%ly(ncgf))
179 584 : ALLOCATE (aux_basis%lz(ncgf))
180 876 : ALLOCATE (aux_basis%m(nsgf))
181 876 : ALLOCATE (aux_basis%cgf_symbol(ncgf))
182 876 : ALLOCATE (aux_basis%sgf_symbol(nsgf))
183 :
184 292 : ncgf = 0
185 292 : nsgf = 0
186 :
187 1268 : DO iset = 1, nsets
188 7128 : DO ishell = 1, aux_basis%nshell(iset)
189 5860 : lshell = aux_basis%l(ishell, iset)
190 24736 : DO ico = ncoset(lshell - 1) + 1, ncoset(lshell)
191 18876 : ncgf = ncgf + 1
192 18876 : aux_basis%lx(ncgf) = indco(1, ico)
193 18876 : aux_basis%ly(ncgf) = indco(2, ico)
194 18876 : 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 81364 : aux_basis%lz(ncgf)/))
199 : END DO
200 23156 : DO m = -lshell, lshell
201 16320 : nsgf = nsgf + 1
202 16320 : aux_basis%m(nsgf) = m
203 : aux_basis%sgf_symbol(nsgf) = &
204 22180 : 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 292 : aux_basis%kind_radius = 0.0_dp
211 292 : aux_basis%short_kind_radius = 0.0_dp
212 876 : ALLOCATE (aux_basis%set_radius(nsets))
213 876 : ALLOCATE (aux_basis%pgf_radius(maxpgf, nsets))
214 1268 : aux_basis%set_radius = 0.0_dp
215 6214 : aux_basis%pgf_radius = 0.0_dp
216 :
217 : ! basis transformation matrices
218 1168 : ALLOCATE (aux_basis%cphi(maxco, ncgf))
219 1168 : ALLOCATE (aux_basis%sphi(maxco, nsgf))
220 876 : ALLOCATE (aux_basis%scon(maxco, nsgf))
221 876 : ALLOCATE (aux_basis%norm_cgf(ncgf))
222 292 : aux_basis%norm_type = 2
223 : ! CALL init_orb_basis_set(aux_basis)
224 :
225 292 : END SUBROUTINE create_aux_basis
226 :
227 : END MODULE aux_basis_set
|
