(git:4cf809f)
Loading...
Searching...
No Matches
qs_oce_methods.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Routines for the construction of the coefficients
10!> for the expansion of the atomic
11!> densities rho1_hard and rho1_soft in terms of primitive spherical gaussians.
12!> \par History
13!> 05-2004 created
14!> \author MI
15! **************************************************************************************************
16MODULE qs_oce_methods
17
18 USE ai_overlap, ONLY: overlap
19 USE ao_util, ONLY: exp_radius
20 USE basis_set_types, ONLY: get_gto_basis_set,&
21 gto_basis_set_type
22 USE block_p_types, ONLY: block_p_type
23 USE kinds, ONLY: dp
24 USE orbital_pointers, ONLY: init_orbital_pointers,&
25 nco,&
26 ncoset,&
27 nso
28 USE orbital_transformation_matrices, ONLY: orbtramat
29 USE particle_types, ONLY: particle_type
30 USE paw_basis_types, ONLY: get_paw_basis_info
31 USE paw_proj_set_types, ONLY: get_paw_proj_set,&
32 paw_proj_set_type
33 USE qs_kind_types, ONLY: get_qs_kind,&
34 get_qs_kind_set,&
35 qs_kind_type
36 USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
37 USE sap_kind_types, ONLY: clist_type,&
38 sap_int_type,&
39 sap_sort
40#include "./base/base_uses.f90"
41
42 IMPLICIT NONE
43
44 PRIVATE
45
46 ! Global parameters (only in this module)
47
48 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_oce_methods'
49
50 ! Public subroutines
51
52 PUBLIC :: build_oce_matrices, proj_blk, prj_scatter, prj_gather
53
54CONTAINS
55
56! **************************************************************************************************
57!> \brief ...
58!> \param oces ...
59!> \param atom_ka ...
60!> \param atom_kb ...
61!> \param rab ...
62!> \param nder ...
63!> \param sgf_list ...
64!> \param nsgf_cnt ...
65!> \param sgf_soft_only ...
66!> \param eps_fit ...
67! **************************************************************************************************
68 SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt, sgf_soft_only, &
69 eps_fit)
70
71 TYPE(block_p_type), DIMENSION(:), POINTER :: oces
72 TYPE(qs_kind_type), POINTER :: atom_ka, atom_kb
73 REAL(KIND=dp), DIMENSION(3) :: rab
74 INTEGER, INTENT(IN) :: nder
75 INTEGER, DIMENSION(:), INTENT(OUT) :: sgf_list
76 INTEGER, INTENT(OUT) :: nsgf_cnt
77 LOGICAL, INTENT(OUT) :: sgf_soft_only
78 REAL(KIND=dp), INTENT(IN) :: eps_fit
79
80 INTEGER :: first_col, ic, ider, ig1, igau, ip, ipgf, is, isgfb, isgfb_cnt, isp, jc, jset, &
81 lds, lm, lpoint, lprj, lsgfb, lsgfb_cnt, lshell, m, m1, maxcob, maxder, maxlb, maxlprj, &
82 maxnprja, maxsoa, msab, n, ncob, np_car, np_sph, nsatbas, nseta, nsetb, nsoatot, &
83 ntotsgfb, sgf_hard_only
84 INTEGER, DIMENSION(:), POINTER :: fp_cara, fp_spha, lb_max, lb_min, npgfb, &
85 nprjla, nsgfb
86 INTEGER, DIMENSION(:, :), POINTER :: first_sgfb
87 LOGICAL :: calculate_forces, paw_atom_a, paw_atom_b
88 REAL(KIND=dp) :: dab, hard_radius_a, hard_radius_b, &
89 radius, rcprja
90 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: ovs, spa_sb
91 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: s
92 REAL(KIND=dp), DIMENSION(:), POINTER :: set_radius_b, zisomina, zisominb
93 REAL(KIND=dp), DIMENSION(:, :), POINTER :: csprj, rpgfb, rzetprja, spa_tmp, sphi_b, &
94 zetb, zetprja
95 TYPE(gto_basis_set_type), POINTER :: basis_1c_a, orb_basis_b
96 TYPE(paw_proj_set_type), POINTER :: paw_proj_a, paw_proj_b
97
98 NULLIFY (basis_1c_a, paw_proj_a)
99 CALL get_qs_kind(qs_kind=atom_ka, basis_set=basis_1c_a, basis_type="GAPW_1C", &
100 paw_proj_set=paw_proj_a, paw_atom=paw_atom_a, &
101 hard_radius=hard_radius_a)
102
103 NULLIFY (orb_basis_b, paw_proj_b)
104 CALL get_qs_kind(qs_kind=atom_kb, basis_set=orb_basis_b, &
105 paw_proj_set=paw_proj_b, paw_atom=paw_atom_b, &
106 hard_radius=hard_radius_b)
107
108 IF (.NOT. paw_atom_a) RETURN
109
110 NULLIFY (nprjla, fp_cara, fp_spha, rzetprja, zetprja)
111 CALL get_paw_proj_set(paw_proj_set=paw_proj_a, csprj=csprj, maxl=maxlprj, &
112 nprj=nprjla, ncgauprj=np_car, nsgauprj=np_sph, nsatbas=nsatbas, rcprj=rcprja, &
113 first_prj=fp_cara, first_prjs=fp_spha, &
114 zisomin=zisomina, rzetprj=rzetprja, zetprj=zetprja)
115
116 NULLIFY (first_sgfb, lb_max, lb_min, npgfb, nsgfb, rpgfb, sphi_b, set_radius_b, zetb, zisominb)
117 CALL get_gto_basis_set(gto_basis_set=orb_basis_b, nset=nsetb, nsgf=ntotsgfb, &
118 set_radius=set_radius_b, lmax=lb_max, lmin=lb_min, &
119 npgf=npgfb, nsgf_set=nsgfb, pgf_radius=rpgfb, &
120 sphi=sphi_b, zet=zetb, first_sgf=first_sgfb, &
121 maxco=maxcob, maxl=maxlb)
122
123 CALL get_gto_basis_set(gto_basis_set=basis_1c_a, nset=nseta, maxso=maxsoa)
124
125 ! Add the block ab
126 dab = sqrt(sum(rab*rab))
127
128 maxder = ncoset(nder)
129 nsoatot = maxsoa*nseta
130 maxnprja = SIZE(zetprja, 1)
131
132 calculate_forces = .false.
133 IF (nder > 0) THEN
134 calculate_forces = .true.
135 END IF
136
137 lm = max(maxlb, maxlprj)
138 lds = ncoset(lm + nder + 1)
139 msab = max(maxnprja*ncoset(maxlprj), maxcob)
140
141 ALLOCATE (s(lds, lds, ncoset(nder + 1)))
142 ALLOCATE (spa_sb(np_car, ntotsgfb))
143 ALLOCATE (spa_tmp(msab, msab*maxder))
144 ALLOCATE (ovs(np_sph, maxcob*nsetb*maxder))
145
146 m1 = 0
147 nsgf_cnt = 0
148 isgfb_cnt = 1
149 sgf_hard_only = 0
150 DO jset = 1, nsetb
151 !
152 ! Set the contribution list
153 IF (hard_radius_a + set_radius_b(jset) >= dab) THEN
154 isgfb = first_sgfb(1, jset)
155 lsgfb = isgfb - 1 + nsgfb(jset)
156 DO jc = isgfb, lsgfb
157 nsgf_cnt = nsgf_cnt + 1
158 sgf_list(nsgf_cnt) = jc
159 END DO
160
161 ! check if this function is hard
162 radius = exp_radius(lb_max(jset), maxval(zetb(1:npgfb(jset), jset)), eps_fit, 1.0_dp)
163 IF (radius <= hard_radius_b) sgf_hard_only = sgf_hard_only + 1
164
165 ! Integral between proj of iatom and primitives of jatom
166 ! Calculate the primitives overlap
167 spa_tmp = 0.0_dp
168 ovs = 0.0_dp
169 s = 0.0_dp
170 ncob = npgfb(jset)*ncoset(lb_max(jset))
171 isgfb = first_sgfb(1, jset)
172 lsgfb = isgfb - 1 + nsgfb(jset)
173
174 lsgfb_cnt = isgfb_cnt - 1 + nsgfb(jset)
175
176 DO lprj = 0, maxlprj
177 CALL overlap(lprj, lprj, nprjla(lprj), &
178 rzetprja(:, lprj), zetprja(:, lprj), &
179 lb_max(jset), lb_min(jset), npgfb(jset), &
180 rpgfb(:, jset), zetb(:, jset), &
181 -rab, dab, spa_tmp, &
182 nder, .true., s, lds)
183 DO ider = 1, maxder
184 is = (ider - 1)*SIZE(spa_tmp, 1)
185 isp = (ider - 1)*maxcob*nsetb
186 DO ipgf = 1, nprjla(lprj)
187 lpoint = ncoset(lprj - 1) + 1 + (ipgf - 1)*ncoset(lprj)
188 m = fp_spha(lprj) + (ipgf - 1)*nso(lprj)
189 DO ip = 1, npgfb(jset)
190 ic = (ip - 1)*ncoset(lb_max(jset))
191 igau = isp + ic + m1 + ncoset(lb_min(jset) - 1) + 1
192 ig1 = is + ic + ncoset(lb_min(jset) - 1) + 1
193 n = ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)
194 ovs(m:m + nso(lprj) - 1, igau:igau + n - 1) = &
195 matmul(orbtramat(lprj)%slm(1:nso(lprj), 1:nco(lprj)), &
196 spa_tmp(lpoint:lpoint + nco(lprj) - 1, ig1:ig1 + n - 1))
197 END DO
198 END DO
199 END DO
200 END DO
201
202 IF (paw_atom_b) THEN
203 CALL get_paw_proj_set(paw_proj_set=paw_proj_b, zisomin=zisominb)
204 DO ipgf = 1, npgfb(jset)
205 DO lshell = lb_min(jset), lb_max(jset)
206 IF (zetb(ipgf, jset) >= zisominb(lshell)) THEN
207 n = ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)
208 igau = n*(ipgf - 1) + ncoset(lshell - 1)
209 DO ider = 1, maxder
210 is = maxcob*(ider - 1)
211 isp = (ider - 1)*maxcob*nsetb
212 ovs(:, igau + 1 + isp + m1:igau + nco(lshell) + isp + m1) = 0.0_dp
213 END DO
214 END IF
215 END DO
216 END DO
217 END IF
218
219 ! Contraction step (integrals and derivatives)
220 DO ider = 1, maxder
221 first_col = (ider - 1)*maxcob*nsetb + 1 + m1
222 ! CALL dgemm("N", "N", np_sph, nsgfb(jset), ncob, &
223 ! 1.0_dp, ovs(1, first_col), SIZE(ovs, 1), &
224 ! sphi_b(1, isgfb), SIZE(sphi_b, 1), &
225 ! 0.0_dp, spa_sb(1, isgfb), SIZE(spa_sb, 1))
226 spa_sb(1:np_sph, isgfb:isgfb + nsgfb(jset) - 1) = &
227 matmul(ovs(1:np_sph, first_col:first_col + ncob - 1), &
228 sphi_b(1:ncob, isgfb:isgfb + nsgfb(jset) - 1))
229
230 ! CALL dgemm("T", "N", nsatbas, nsgfb(jset), np_sph, &
231 ! 1.0_dp, csprj(1, 1), SIZE(csprj, 1), &
232 ! spa_sb(1, isgfb), SIZE(spa_sb, 1), &
233 ! 1.0_dp, oces(ider)%block(1, isgfb_cnt), SIZE(oces(ider)%block, 1))
234 oces(ider)%block(1:nsatbas, isgfb_cnt:isgfb_cnt + nsgfb(jset) - 1) = &
235 oces(ider)%block(1:nsatbas, isgfb_cnt:isgfb_cnt + nsgfb(jset) - 1) + &
236 matmul(transpose(csprj(1:np_sph, 1:nsatbas)), &
237 spa_sb(1:np_sph, isgfb:isgfb + nsgfb(jset) - 1))
238 END DO
239 isgfb_cnt = isgfb_cnt + nsgfb(jset)
240 END IF ! radius
241 m1 = m1 + maxcob
242 END DO !jset
243
244 ! Check if the screened functions are all soft
245 sgf_soft_only = .false.
246 IF (sgf_hard_only == 0) sgf_soft_only = .true.
247
248 DEALLOCATE (s, spa_sb, spa_tmp, ovs)
249
250 END SUBROUTINE build_oce_block
251
252! **************************************************************************************************
253!> \brief ...
254!> \param oceh ...
255!> \param oces ...
256!> \param atom_ka ...
257!> \param sgf_list ...
258!> \param nsgf_cnt ...
259! **************************************************************************************************
260 SUBROUTINE build_oce_block_local(oceh, oces, atom_ka, sgf_list, nsgf_cnt)
261
262 TYPE(block_p_type), DIMENSION(:), POINTER :: oceh, oces
263 TYPE(qs_kind_type), POINTER :: atom_ka
264 INTEGER, DIMENSION(:), INTENT(OUT) :: sgf_list
265 INTEGER, INTENT(OUT) :: nsgf_cnt
266
267 INTEGER :: i, iset, isgfa, j, jc, lsgfa, maxlprj, &
268 maxso1a, n, nsatbas, nset1a, nseta, &
269 nsgfa
270 INTEGER, DIMENSION(:), POINTER :: n2oindex, nsgf_seta
271 INTEGER, DIMENSION(:, :), POINTER :: first_sgfa
272 LOGICAL :: paw_atom_a
273 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: prjloc_h, prjloc_s
274 REAL(KIND=dp), DIMENSION(:, :), POINTER :: local_oce_h, local_oce_s
275 TYPE(gto_basis_set_type), POINTER :: basis_1c_a, orb_basis_a
276 TYPE(paw_proj_set_type), POINTER :: paw_proj_a
277
278 NULLIFY (orb_basis_a, basis_1c_a, paw_proj_a)
279 CALL get_qs_kind(qs_kind=atom_ka, basis_set=orb_basis_a, &
280 paw_proj_set=paw_proj_a, paw_atom=paw_atom_a)
281
282 IF (.NOT. paw_atom_a) RETURN
283
284 CALL get_paw_proj_set(paw_proj_set=paw_proj_a, maxl=maxlprj)
285 CALL get_qs_kind(qs_kind=atom_ka, basis_set=basis_1c_a, basis_type="GAPW_1C")
286 CALL get_gto_basis_set(gto_basis_set=basis_1c_a, nset=nset1a, maxso=maxso1a)
287 NULLIFY (n2oindex)
288 CALL get_paw_basis_info(basis_1c_a, n2oindex=n2oindex, nsatbas=nsatbas)
289
290 CALL get_gto_basis_set(gto_basis_set=orb_basis_a, first_sgf=first_sgfa, &
291 nsgf=nsgfa, nsgf_set=nsgf_seta, nset=nseta)
292
293 NULLIFY (local_oce_h, local_oce_s)
294 CALL get_paw_proj_set(paw_proj_set=paw_proj_a, &
295 local_oce_sphi_h=local_oce_h, &
296 local_oce_sphi_s=local_oce_s)
297
298 ALLOCATE (prjloc_h(nset1a*maxso1a, nsgfa), prjloc_s(nset1a*maxso1a, nsgfa))
299 prjloc_h = 0._dp
300 prjloc_s = 0._dp
301
302 nsgf_cnt = 0
303 DO iset = 1, nseta
304 isgfa = first_sgfa(1, iset)
305 lsgfa = isgfa - 1 + nsgf_seta(iset)
306 DO jc = isgfa, lsgfa
307 nsgf_cnt = nsgf_cnt + 1
308 sgf_list(nsgf_cnt) = jc
309 END DO
310 ! this asumes that the first sets are the same for basis_1c/orb_basis!
311 n = maxso1a*(iset - 1)
312 prjloc_h(n + 1:n + maxso1a, isgfa:lsgfa) = local_oce_h(1:maxso1a, isgfa:lsgfa)
313 prjloc_s(n + 1:n + maxso1a, isgfa:lsgfa) = local_oce_s(1:maxso1a, isgfa:lsgfa)
314 END DO
315
316 DO i = 1, nsgfa
317 DO j = 1, nsatbas
318 jc = n2oindex(j)
319 oceh(1)%block(j, i) = prjloc_h(jc, i)
320 oces(1)%block(j, i) = prjloc_s(jc, i)
321 END DO
322 END DO
323
324 DEALLOCATE (prjloc_h, prjloc_s)
325 DEALLOCATE (n2oindex)
326
327 END SUBROUTINE build_oce_block_local
328
329! **************************************************************************************************
330!> \brief ...
331!> \param oceh ...
332!> \param oces ...
333!> \param atom_ka ...
334!> \param sgf_list ...
335!> \param nsgf_cnt ...
336!> \param eps_fit ...
337! **************************************************************************************************
338 SUBROUTINE build_oce_block_1c(oceh, oces, atom_ka, sgf_list, nsgf_cnt, eps_fit)
339
340 TYPE(block_p_type), DIMENSION(:), POINTER :: oceh, oces
341 TYPE(qs_kind_type), POINTER :: atom_ka
342 INTEGER, DIMENSION(:), INTENT(OUT) :: sgf_list
343 INTEGER, INTENT(OUT) :: nsgf_cnt
344 REAL(KIND=dp), INTENT(IN) :: eps_fit
345
346 INTEGER :: first_col, ic, ig1, igau, ip, ipgf, isgfb, isgfb_cnt, jc, jset, lds, lm, lpoint, &
347 lprj, lsgfb, lsgfb_cnt, lshell, m, m1, maxcob, maxlb, maxlprj, maxnprja, maxsoa, msab, n, &
348 ncob, np_car, np_sph, nsatbas, nseta, nsetb, nsoatot, ntotsgfb
349 INTEGER, DIMENSION(:), POINTER :: fp_cara, fp_spha, lb_max, lb_min, npgfb, &
350 nprjla, nsgfb
351 INTEGER, DIMENSION(:, :), POINTER :: first_sgfb
352 LOGICAL :: paw_atom_a
353 REAL(KIND=dp) :: radius, rc, rcprja
354 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: ovh, ovs, spa_sb
355 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: s
356 REAL(KIND=dp), DIMENSION(:), POINTER :: set_radius_b, zisominb
357 REAL(KIND=dp), DIMENSION(:, :), POINTER :: chprj, csprj, rpgfb, rzetprja, spa_tmp, &
358 sphi_b, zetb, zetprja
359 TYPE(gto_basis_set_type), POINTER :: basis_1c_a, orb_basis_b
360 TYPE(paw_proj_set_type), POINTER :: paw_proj_a
361
362 NULLIFY (orb_basis_b, basis_1c_a, paw_proj_a)
363 CALL get_qs_kind(qs_kind=atom_ka, paw_atom=paw_atom_a)
364
365 IF (.NOT. paw_atom_a) RETURN
366
367 CALL get_qs_kind(qs_kind=atom_ka, paw_proj_set=paw_proj_a)
368 NULLIFY (nprjla, fp_cara, fp_spha, rzetprja, zetprja)
369 CALL get_paw_proj_set(paw_proj_set=paw_proj_a, csprj=csprj, chprj=chprj, maxl=maxlprj, &
370 nprj=nprjla, ncgauprj=np_car, nsgauprj=np_sph, nsatbas=nsatbas, rcprj=rcprja, &
371 first_prj=fp_cara, first_prjs=fp_spha, &
372 rzetprj=rzetprja, zetprj=zetprja)
373
374 CALL get_qs_kind(qs_kind=atom_ka, basis_set=orb_basis_b)
375 NULLIFY (first_sgfb, lb_max, lb_min, npgfb, nsgfb, rpgfb, sphi_b, set_radius_b, zetb, zisominb)
376 CALL get_gto_basis_set(gto_basis_set=orb_basis_b, nset=nsetb, nsgf=ntotsgfb, &
377 set_radius=set_radius_b, lmax=lb_max, lmin=lb_min, &
378 npgf=npgfb, nsgf_set=nsgfb, pgf_radius=rpgfb, &
379 sphi=sphi_b, zet=zetb, first_sgf=first_sgfb, &
380 maxco=maxcob, maxl=maxlb)
381
382 CALL get_qs_kind(qs_kind=atom_ka, hard_radius=rc)
383
384 CALL get_qs_kind(qs_kind=atom_ka, basis_set=basis_1c_a, basis_type="GAPW_1C")
385 CALL get_gto_basis_set(gto_basis_set=basis_1c_a, nset=nseta, maxso=maxsoa)
386
387 ! Add the block ab
388 nsoatot = maxsoa*nseta
389 maxnprja = SIZE(zetprja, 1)
390
391 lm = max(maxlb, maxlprj)
392 lds = ncoset(lm + 1)
393 msab = max(maxnprja*ncoset(maxlprj), maxcob)
394
395 ALLOCATE (s(lds, lds, 1))
396 ALLOCATE (spa_sb(np_car, ntotsgfb))
397 ALLOCATE (spa_tmp(msab, msab))
398 ALLOCATE (ovs(np_sph, maxcob*nsetb))
399 ALLOCATE (ovh(np_sph, maxcob*nsetb))
400
401 m1 = 0
402 nsgf_cnt = 0
403 isgfb_cnt = 1
404 DO jset = 1, nsetb
405 !
406 ! Set the contribution list
407 isgfb = first_sgfb(1, jset)
408 lsgfb = isgfb - 1 + nsgfb(jset)
409 DO jc = isgfb, lsgfb
410 nsgf_cnt = nsgf_cnt + 1
411 sgf_list(nsgf_cnt) = jc
412 END DO
413
414 ! Integral between proj of iatom and primitives of iatom
415 ! Calculate the primitives overlap
416 spa_tmp = 0.0_dp
417 ovs = 0.0_dp
418 ovh = 0.0_dp
419 s = 0.0_dp
420 ncob = npgfb(jset)*ncoset(lb_max(jset))
421 isgfb = first_sgfb(1, jset)
422 lsgfb = isgfb - 1 + nsgfb(jset)
423
424 lsgfb_cnt = isgfb_cnt - 1 + nsgfb(jset)
425
426 DO lprj = 0, maxlprj
427 CALL overlap(lprj, lprj, nprjla(lprj), &
428 rzetprja(:, lprj), zetprja(:, lprj), &
429 lb_max(jset), lb_min(jset), npgfb(jset), &
430 rpgfb(:, jset), zetb(:, jset), &
431 -[0._dp, 0._dp, 0._dp], 0.0_dp, spa_tmp, &
432 0, .true., s, lds)
433 DO ipgf = 1, nprjla(lprj)
434 lpoint = ncoset(lprj - 1) + 1 + (ipgf - 1)*ncoset(lprj)
435 m = fp_spha(lprj) + (ipgf - 1)*nso(lprj)
436 DO ip = 1, npgfb(jset)
437 ic = (ip - 1)*ncoset(lb_max(jset))
438 igau = ic + m1 + ncoset(lb_min(jset) - 1) + 1
439 ig1 = ic + ncoset(lb_min(jset) - 1) + 1
440 n = ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)
441 ovs(m:m + nso(lprj) - 1, igau:igau + n - 1) = &
442 matmul(orbtramat(lprj)%slm(1:nso(lprj), 1:nco(lprj)), &
443 spa_tmp(lpoint:lpoint + nco(lprj) - 1, ig1:ig1 + n - 1))
444 END DO
445 END DO
446 END DO
447
448 ovh(:, :) = ovs(:, :)
449
450 CALL get_paw_proj_set(paw_proj_set=paw_proj_a, zisomin=zisominb)
451 DO ipgf = 1, npgfb(jset)
452 DO lshell = lb_min(jset), lb_max(jset)
453 radius = exp_radius(lshell, zetb(ipgf, jset), eps_fit, 1.0_dp)
454 IF (radius < rc) THEN
455 n = ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)
456 igau = n*(ipgf - 1) + ncoset(lshell - 1)
457 ovs(:, igau + 1 + m1:igau + nco(lshell) + m1) = 0.0_dp
458 END IF
459 END DO
460 END DO
461
462 ! Contraction step (integrals and derivatives)
463 first_col = 1 + m1
464 spa_sb(1:np_sph, isgfb:isgfb + nsgfb(jset) - 1) = &
465 matmul(ovs(1:np_sph, first_col:first_col + ncob - 1), &
466 sphi_b(1:ncob, isgfb:isgfb + nsgfb(jset) - 1))
467
468 oces(1)%block(1:nsatbas, isgfb_cnt:isgfb_cnt + nsgfb(jset) - 1) = &
469 oces(1)%block(1:nsatbas, isgfb_cnt:isgfb_cnt + nsgfb(jset) - 1) + &
470 matmul(transpose(csprj(1:np_sph, 1:nsatbas)), &
471 spa_sb(1:np_sph, isgfb:isgfb + nsgfb(jset) - 1))
472
473 spa_sb(1:np_sph, isgfb:isgfb + nsgfb(jset) - 1) = &
474 matmul(ovh(1:np_sph, first_col:first_col + ncob - 1), &
475 sphi_b(1:ncob, isgfb:isgfb + nsgfb(jset) - 1))
476
477 oceh(1)%block(1:nsatbas, isgfb_cnt:isgfb_cnt + nsgfb(jset) - 1) = &
478 oceh(1)%block(1:nsatbas, isgfb_cnt:isgfb_cnt + nsgfb(jset) - 1) + &
479 matmul(transpose(chprj(1:np_sph, 1:nsatbas)), &
480 spa_sb(1:np_sph, isgfb:isgfb + nsgfb(jset) - 1))
481
482 isgfb_cnt = isgfb_cnt + nsgfb(jset)
483 m1 = m1 + maxcob
484 END DO !jset
485
486 DEALLOCATE (s, spa_sb, spa_tmp, ovs)
487
488 END SUBROUTINE build_oce_block_1c
489
490! **************************************************************************************************
491!> \brief Set up the sparse matrix for the coefficients of one center expansions
492!> This routine uses the same logic as the nonlocal pseudopotential
493!> \param intac TYPE that holds the integrals (a=basis; c=projector)
494!> \param calculate_forces ...
495!> \param nder ...
496!> \param qs_kind_set ...
497!> \param particle_set ...
498!> \param sap_oce ...
499!> \param eps_fit ...
500!> \par History
501!> 02.2009 created
502!> \author jgh
503! **************************************************************************************************
504 SUBROUTINE build_oce_matrices(intac, calculate_forces, nder, &
505 qs_kind_set, particle_set, sap_oce, eps_fit)
506
507 TYPE(sap_int_type), DIMENSION(:), POINTER :: intac
508 LOGICAL, INTENT(IN) :: calculate_forces
509 INTEGER :: nder
510 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
511 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
512 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
513 POINTER :: sap_oce
514 REAL(kind=dp), INTENT(IN) :: eps_fit
515
516 CHARACTER(LEN=*), PARAMETER :: routinen = 'build_oce_matrices'
517
518 INTEGER :: atom_a, atom_b, handle, i, iac, ikind, ilist, jkind, jneighbor, ldai, ldsab, &
519 maxco, maxder, maxl, maxlgto, maxlprj, maxprj, maxsgf, maxsoa, maxsob, mlprj, natom, &
520 ncoa_sum, nkind, nlist, nneighbor, nsatbas, nseta, nsetb, nsgf_cnt, nsgfa, nsobtot, slot
521 INTEGER, ALLOCATABLE, DIMENSION(:) :: sgf_list
522 INTEGER, DIMENSION(3) :: cell_b
523 INTEGER, DIMENSION(:), POINTER :: fp_car, fp_sph, la_max, la_min, npgfa, &
524 nprjla, nsgf_seta
525 INTEGER, DIMENSION(:, :), POINTER :: first_sgfa
526 LOGICAL :: local, paw_atom_b, sgf_soft_only
527 LOGICAL, ALLOCATABLE, DIMENSION(:) :: has_1c_basis, has_orb_basis, paw_kind
528 REAL(kind=dp) :: dab, rcprj
529 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: sab, work
530 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: ai_work
531 REAL(kind=dp), DIMENSION(3) :: rab
532 REAL(kind=dp), DIMENSION(:), POINTER :: set_radius_a
533 REAL(kind=dp), DIMENSION(:, :), POINTER :: rpgfa, rzetprj, sphi_a, zeta, zetb
534 TYPE(block_p_type), DIMENSION(:), POINTER :: oceh, oces
535 TYPE(clist_type), POINTER :: clist
536 TYPE(gto_basis_set_type), POINTER :: orb_basis_paw, orb_basis_set
537 TYPE(paw_proj_set_type), POINTER :: paw_proj_b
538 TYPE(qs_kind_type), POINTER :: at_a, at_b, qs_kind
539
540 IF (calculate_forces) THEN
541 CALL timeset(routinen//"_forces", handle)
542 ELSE
543 CALL timeset(routinen, handle)
544 END IF
545
546 IF (ASSOCIATED(sap_oce)) THEN
547
548 nkind = SIZE(qs_kind_set)
549 natom = SIZE(particle_set)
550
551 maxder = ncoset(nder)
552
553 CALL get_qs_kind_set(qs_kind_set=qs_kind_set, &
554 maxco=maxco, &
555 maxlgto=maxlgto, &
556 maxlprj=maxlprj, &
557 maxco_proj=maxprj, &
558 maxsgf=maxsgf)
559
560 maxl = max(maxlgto, maxlprj)
561 CALL init_orbital_pointers(maxl + nder + 1)
562
563 DO i = 1, nkind*nkind
564 NULLIFY (intac(i)%alist, intac(i)%asort, intac(i)%aindex)
565 intac(i)%nalist = 0
566 END DO
567
568 ALLOCATE (has_orb_basis(nkind), paw_kind(nkind), has_1c_basis(nkind))
569 has_orb_basis(:) = .false.
570 paw_kind(:) = .false.
571 has_1c_basis(:) = .false.
572 DO ikind = 1, nkind
573 NULLIFY (orb_basis_set)
574 CALL get_qs_kind(qs_kind=qs_kind_set(ikind), basis_set=orb_basis_set)
575 has_orb_basis(ikind) = ASSOCIATED(orb_basis_set)
576 NULLIFY (paw_proj_b)
577 CALL get_qs_kind(qs_kind=qs_kind_set(ikind), paw_proj_set=paw_proj_b, paw_atom=paw_kind(ikind))
578 NULLIFY (orb_basis_paw)
579 CALL get_qs_kind(qs_kind=qs_kind_set(ikind), basis_set=orb_basis_paw, basis_type="GAPW_1C")
580 has_1c_basis(ikind) = ASSOCIATED(orb_basis_paw)
581 END DO
582
583 ! Allocate memory list
584 DO slot = 1, sap_oce(1)%nl_size
585 ikind = sap_oce(1)%nlist_task(slot)%ikind
586 jkind = sap_oce(1)%nlist_task(slot)%jkind
587 atom_a = sap_oce(1)%nlist_task(slot)%iatom
588 nlist = sap_oce(1)%nlist_task(slot)%nlist
589 ilist = sap_oce(1)%nlist_task(slot)%ilist
590 nneighbor = sap_oce(1)%nlist_task(slot)%nnode
591
592 iac = ikind + nkind*(jkind - 1)
593
594 IF (.NOT. has_orb_basis(ikind)) cycle
595 IF (.NOT. paw_kind(jkind)) cycle
596 IF (.NOT. has_1c_basis(jkind)) cycle
597 IF (.NOT. ASSOCIATED(intac(iac)%alist)) THEN
598 intac(iac)%a_kind = ikind
599 intac(iac)%p_kind = jkind
600 intac(iac)%nalist = nlist
601 ALLOCATE (intac(iac)%alist(nlist))
602 DO i = 1, nlist
603 NULLIFY (intac(iac)%alist(i)%clist)
604 intac(iac)%alist(i)%aatom = 0
605 intac(iac)%alist(i)%nclist = 0
606 END DO
607 END IF
608 IF (.NOT. ASSOCIATED(intac(iac)%alist(ilist)%clist)) THEN
609 intac(iac)%alist(ilist)%aatom = atom_a
610 intac(iac)%alist(ilist)%nclist = nneighbor
611 ALLOCATE (intac(iac)%alist(ilist)%clist(nneighbor))
612 END IF
613 END DO
614
615 ldsab = max(maxco, ncoset(maxlprj), maxsgf, maxprj)
616 ldai = ncoset(maxl + nder + 1)
617
618 !calculate the overlap integrals <a|p>
619!$OMP PARALLEL DEFAULT(NONE) &
620!$OMP SHARED (intac, ldsab, ldai, nder, nkind, maxder, ncoset, sap_oce, qs_kind_set, eps_fit, &
621!$OMP has_orb_basis, paw_kind, has_1c_basis, maxsgf) &
622!$OMP PRIVATE (sab, work, ai_work, oceh, oces, slot, ikind, jkind, atom_a, atom_b, ilist, jneighbor, rab, cell_b, &
623!$OMP iac, dab, qs_kind, orb_basis_set, first_sgfa, la_max, la_min, ncoa_sum, maxsoa, npgfa, nseta, &
624!$OMP nsgfa, nsgf_seta, rpgfa, set_radius_a, sphi_a, zeta, paw_proj_b, paw_atom_b, orb_basis_paw, &
625!$OMP maxsob, nsetb, mlprj, nprjla, nsatbas, rcprj, fp_car, fp_sph, rzetprj, zetb, nsobtot, clist, &
626!$OMP sgf_list, at_a, at_b, local, i, sgf_soft_only, nsgf_cnt)
627
628 ALLOCATE (sab(ldsab, ldsab*maxder), work(ldsab, ldsab*maxder))
629 sab = 0.0_dp
630 ALLOCATE (ai_work(ldai, ldai, ncoset(nder + 1)))
631 ai_work = 0.0_dp
632 ALLOCATE (oceh(maxder), oces(maxder))
633 ALLOCATE (sgf_list(maxsgf))
634
635!$OMP DO SCHEDULE(GUIDED)
636 DO slot = 1, sap_oce(1)%nl_size
637 ikind = sap_oce(1)%nlist_task(slot)%ikind
638 jkind = sap_oce(1)%nlist_task(slot)%jkind
639 atom_a = sap_oce(1)%nlist_task(slot)%iatom
640 atom_b = sap_oce(1)%nlist_task(slot)%jatom
641 ilist = sap_oce(1)%nlist_task(slot)%ilist
642 jneighbor = sap_oce(1)%nlist_task(slot)%inode
643 rab(1:3) = sap_oce(1)%nlist_task(slot)%r(1:3)
644 cell_b(1:3) = sap_oce(1)%nlist_task(slot)%cell(1:3)
645
646 iac = ikind + nkind*(jkind - 1)
647 dab = sqrt(sum(rab*rab))
648
649 IF (.NOT. has_orb_basis(ikind)) cycle
650 IF (.NOT. paw_kind(jkind)) cycle
651 IF (.NOT. has_1c_basis(jkind)) cycle
652
653 qs_kind => qs_kind_set(ikind)
654 CALL get_qs_kind(qs_kind=qs_kind, basis_set=orb_basis_set)
655
656 IF (.NOT. ASSOCIATED(orb_basis_set)) cycle
657 CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
658 first_sgf=first_sgfa, &
659 lmax=la_max, &
660 lmin=la_min, &
661 nco_sum=ncoa_sum, &
662 maxso=maxsoa, &
663 npgf=npgfa, &
664 nset=nseta, &
665 nsgf=nsgfa, &
666 nsgf_set=nsgf_seta, &
667 pgf_radius=rpgfa, &
668 set_radius=set_radius_a, &
669 sphi=sphi_a, &
670 zet=zeta)
671
672 qs_kind => qs_kind_set(jkind)
673
674 NULLIFY (paw_proj_b)
675 CALL get_qs_kind(qs_kind=qs_kind, paw_proj_set=paw_proj_b, paw_atom=paw_atom_b)
676 IF (.NOT. paw_atom_b) cycle
677
678 CALL get_qs_kind(qs_kind=qs_kind, basis_set=orb_basis_paw, basis_type="GAPW_1C")
679 IF (.NOT. ASSOCIATED(orb_basis_paw)) cycle
680 CALL get_gto_basis_set(gto_basis_set=orb_basis_paw, maxso=maxsob, nset=nsetb)
681
682 CALL get_paw_proj_set(paw_proj_set=paw_proj_b, &
683 maxl=mlprj, &
684 nprj=nprjla, &
685 nsatbas=nsatbas, &
686 rcprj=rcprj, &
687 first_prj=fp_car, &
688 first_prjs=fp_sph, &
689 rzetprj=rzetprj, &
690 zetprj=zetb)
691
692 nsobtot = nsatbas
693
694 clist => intac(iac)%alist(ilist)%clist(jneighbor)
695 clist%catom = atom_b
696 clist%cell = cell_b
697 clist%rac = rab
698 clist%nsgf_cnt = 0
699 clist%maxac = 0.0_dp
700 clist%maxach = 0.0_dp
701 NULLIFY (clist%acint, clist%achint, clist%sgf_list)
702
703 at_a => qs_kind_set(jkind)
704 at_b => qs_kind_set(ikind)
705
706 local = (atom_a == atom_b .AND. all(cell_b == 0))
707
708 IF (local) THEN
709 DO i = 1, maxder
710 ALLOCATE (oceh(i)%block(nsobtot, nsgfa), oces(i)%block(nsobtot, nsgfa))
711 oceh(i)%block = 0._dp
712 oces(i)%block = 0._dp
713 END DO
714 CALL build_oce_block_local(oceh, oces, at_a, sgf_list, nsgf_cnt)
715 clist%nsgf_cnt = nsgf_cnt
716 clist%sgf_soft_only = .false.
717 IF (nsgf_cnt > 0) THEN
718 ALLOCATE (clist%acint(nsgf_cnt, nsobtot, maxder), clist%sgf_list(nsgf_cnt))
719 clist%acint(:, :, :) = 0._dp
720 clist%sgf_list(:) = huge(0)
721 cpassert(nsgf_cnt == nsgfa)
722 ! *** Special case: A=B
723 ALLOCATE (clist%achint(nsgfa, nsobtot, maxder))
724 clist%achint = 0._dp
725 clist%acint(1:nsgfa, 1:nsobtot, 1) = transpose(oces(1)%block(1:nsobtot, 1:nsgfa))
726 clist%achint(1:nsgfa, 1:nsobtot, 1) = transpose(oceh(1)%block(1:nsobtot, 1:nsgfa))
727 clist%maxac = maxval(abs(clist%acint(:, :, 1)))
728 clist%maxach = 0._dp
729 clist%sgf_list(1:nsgf_cnt) = sgf_list(1:nsgf_cnt)
730 END IF
731 DO i = 1, maxder
732 DEALLOCATE (oceh(i)%block, oces(i)%block)
733 END DO
734 ELSE
735 DO i = 1, maxder
736 ALLOCATE (oces(i)%block(nsobtot, nsgfa))
737 oces(i)%block = 0._dp
738 END DO
739 CALL build_oce_block(oces, at_a, at_b, rab, nder, sgf_list, nsgf_cnt, sgf_soft_only, eps_fit)
740 clist%nsgf_cnt = nsgf_cnt
741 clist%sgf_soft_only = sgf_soft_only
742 IF (nsgf_cnt > 0) THEN
743 ALLOCATE (clist%acint(nsgf_cnt, nsobtot, maxder), clist%sgf_list(nsgf_cnt))
744 clist%acint(:, :, :) = 0._dp
745 clist%sgf_list(:) = huge(0)
746 DO i = 1, maxder
747 clist%acint(1:nsgf_cnt, 1:nsobtot, i) = transpose(oces(i)%block(1:nsobtot, 1:nsgf_cnt))
748 END DO
749 clist%maxac = maxval(abs(clist%acint(:, :, 1)))
750 clist%maxach = 0._dp
751 clist%sgf_list(1:nsgf_cnt) = sgf_list(1:nsgf_cnt)
752 END IF
753 DO i = 1, maxder
754 DEALLOCATE (oces(i)%block)
755 END DO
756 END IF
757
758 END DO
759
760 DEALLOCATE (sab, work, ai_work)
761 DEALLOCATE (sgf_list)
762 DEALLOCATE (oceh, oces)
763!$OMP END PARALLEL
764
765 ! Setup sort index
766 CALL sap_sort(intac)
767
768 DEALLOCATE (has_orb_basis, paw_kind, has_1c_basis)
769
770 END IF
771
772 CALL timestop(handle)
773
774 END SUBROUTINE build_oce_matrices
775
776! **************************************************************************************************
777!> \brief Project a matrix block onto the local atomic functions.
778!>
779!> \param h_a ...
780!> \param s_a ...
781!> \param na ...
782!> \param h_b ...
783!> \param s_b ...
784!> \param nb ...
785!> \param blk ...
786!> \param ldb ...
787!> \param proj_h ...
788!> \param proj_s ...
789!> \param nso ...
790!> \param len1 ...
791!> \param len2 ...
792!> \param fac ...
793!> \param distab ...
794!> \param work1 ...
795!> \param work2 ...
796!> \par History
797!> 02.2009 created
798!> 09.2016 use automatic arrays [M Tucker]
799!> 05.2026 move work arrays to callers
800! **************************************************************************************************
801 SUBROUTINE proj_blk(h_a, s_a, na, h_b, s_b, nb, blk, ldb, proj_h, proj_s, nso, len1, len2, fac, distab, &
802 work1, work2)
803
804 INTEGER, INTENT(IN) :: na
805 REAL(kind=dp), INTENT(IN) :: s_a(na, *), h_a(na, *)
806 INTEGER, INTENT(IN) :: nb
807 REAL(kind=dp), INTENT(IN) :: s_b(nb, *), h_b(nb, *)
808 INTEGER, INTENT(IN) :: ldb
809 REAL(kind=dp), INTENT(IN) :: blk(ldb, *)
810 INTEGER, INTENT(IN) :: nso
811 REAL(kind=dp), INTENT(INOUT) :: proj_s(nso, *), proj_h(nso, *)
812 INTEGER, INTENT(IN) :: len1, len2
813 REAL(kind=dp), INTENT(IN) :: fac
814 LOGICAL, INTENT(IN) :: distab
815 REAL(kind=dp), INTENT(INOUT) :: work1(len1), work2(len2)
816
817 IF (na == 0 .OR. nb == 0 .OR. nso == 0) RETURN
818
819 ! Handle special cases
820 IF (na == 1 .AND. nb == 1) THEN
821 ! hard
822 CALL dger(nso, nso, fac*blk(1, 1), h_a(1, 1), 1, h_b(1, 1), 1, proj_h(1, 1), nso)
823 ! soft
824 CALL dger(nso, nso, fac*blk(1, 1), s_a(1, 1), 1, s_b(1, 1), 1, proj_s(1, 1), nso)
825 ELSE
826 IF (distab) THEN
827 ! hard
828 CALL dgemm('N', 'N', na, nso, nb, fac, blk(1, 1), ldb, h_b(1, 1), nb, 0.0_dp, work1(1), na)
829 CALL dgemm('T', 'N', nso, nso, na, 1.0_dp, h_a(1, 1), na, work1(1), na, 0.0_dp, work2(1), nso)
830 CALL daxpy(nso*nso, 1.0_dp, work2(1), 1, proj_h(1, 1), 1)
831 ! soft
832 CALL daxpy(nso*nso, 1.0_dp, work2(1), 1, proj_s(1, 1), 1)
833 ELSE
834 ! hard
835 CALL dgemm('N', 'N', na, nso, nb, fac, blk(1, 1), ldb, h_b(1, 1), nb, 0.0_dp, work1(1), na)
836 CALL dgemm('T', 'N', nso, nso, na, 1.0_dp, h_a(1, 1), na, work1(1), na, 1.0_dp, proj_h(1, 1), nso)
837 ! soft
838 CALL dgemm('N', 'N', na, nso, nb, fac, blk(1, 1), ldb, s_b(1, 1), nb, 0.0_dp, work1(1), na)
839 CALL dgemm('T', 'N', nso, nso, na, 1.0_dp, s_a(1, 1), na, work1(1), na, 1.0_dp, proj_s(1, 1), nso)
840 END IF
841 END IF
842
843 END SUBROUTINE proj_blk
844
845! **************************************************************************************************
846!> \brief ...
847!> \param ain matrix in old indexing
848!> \param aout matrix in new compressed indexing
849!> \param atom ...
850! **************************************************************************************************
851 SUBROUTINE prj_gather(ain, aout, atom)
852
853 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: ain
854 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: aout
855 TYPE(qs_kind_type), INTENT(IN) :: atom
856
857 INTEGER :: i, ip, j, jp, nbas
858 INTEGER, DIMENSION(:), POINTER :: n2oindex
859 TYPE(gto_basis_set_type), POINTER :: basis_1c
860
861 NULLIFY (basis_1c)
862 CALL get_qs_kind(qs_kind=atom, basis_set=basis_1c, basis_type="GAPW_1C")
863 NULLIFY (n2oindex)
864 CALL get_paw_basis_info(basis_1c, n2oindex=n2oindex, nsatbas=nbas)
865
866 DO i = 1, nbas
867 ip = n2oindex(i)
868 DO j = 1, nbas
869 jp = n2oindex(j)
870 aout(j, i) = ain(jp, ip)
871 END DO
872 END DO
873
874 DEALLOCATE (n2oindex)
875
876 END SUBROUTINE prj_gather
877
878! **************************************************************************************************
879!> \brief ...
880!> \param ain matrix in new compressed indexing
881!> \param aout matrix in old indexing (addup)
882!> \param atom ...
883! **************************************************************************************************
884 SUBROUTINE prj_scatter(ain, aout, atom)
885
886 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: ain
887 REAL(kind=dp), DIMENSION(:, :), INTENT(INOUT) :: aout
888 TYPE(qs_kind_type), INTENT(IN) :: atom
889
890 INTEGER :: i, ip, j, jp, nbas
891 INTEGER, DIMENSION(:), POINTER :: n2oindex
892 TYPE(gto_basis_set_type), POINTER :: basis_1c
893
894 NULLIFY (basis_1c)
895 CALL get_qs_kind(qs_kind=atom, basis_set=basis_1c, basis_type="GAPW_1C")
896 NULLIFY (n2oindex)
897 CALL get_paw_basis_info(basis_1c, n2oindex=n2oindex, nsatbas=nbas)
898
899 DO i = 1, nbas
900 ip = n2oindex(i)
901 DO j = 1, nbas
902 jp = n2oindex(j)
903 aout(jp, ip) = aout(jp, ip) + ain(j, i)
904 END DO
905 END DO
906
907 DEALLOCATE (n2oindex)
908
909 END SUBROUTINE prj_scatter
910
911END MODULE qs_oce_methods
fac
static GRID_HOST_DEVICE double fac(const int i)
Factorial function, e.g. fac(5) = 5! = 120.
Definition grid_common.h:56
dgemm
static void dgemm(const char transa, const char transb, const int m, const int n, const int k, const double alpha, const double *a, const int lda, const double *b, const int ldb, const double beta, double *c, const int ldc)
Convenient wrapper to hide Fortran nature of dgemm_, swapping a and b.
Definition grid_cpu_task_list.c:225
ai_overlap
Calculation of the overlap integrals over Cartesian Gaussian-type functions.
Definition ai_overlap.F:18
ai_overlap::overlap
subroutine, public overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, lb_max_set, lb_min_set, npgfb, rpgfb, zetb, rab, dab, sab, da_max_set, return_derivatives, s, lds, sdab, pab, force_a)
Purpose: Calculation of the two-center overlap integrals [a|b] over Cartesian Gaussian-type functions...
Definition ai_overlap.F:74
ao_util
All kind of helpful little routines.
Definition ao_util.F:14
ao_util::exp_radius
real(kind=dp) function, public exp_radius(l, alpha, threshold, prefactor, epsabs, epsrel, rlow)
The radius of a primitive Gaussian function for a given threshold is calculated. g(r) = prefactor*r**...
Definition ao_util.F:96
atom
Definition atom.F:9
basis_set_types
Definition basis_set_types.F:15
basis_set_types::get_gto_basis_set
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum, ccon)
...
Definition basis_set_types.F:643
block_p_types
collect pointers to a block of reals
Definition block_p_types.F:14
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
orbital_pointers
Provides Cartesian and spherical orbital pointers and indices.
Definition orbital_pointers.F:15
orbital_pointers::init_orbital_pointers
subroutine, public init_orbital_pointers(maxl)
Initialize or update the orbital pointers.
Definition orbital_pointers.F:253
orbital_pointers::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::nso
integer, dimension(:), allocatable, public nso
Definition orbital_pointers.F:42
orbital_transformation_matrices
Calculation of the spherical harmonics and the corresponding orbital transformation matrices.
Definition orbital_transformation_matrices.F:17
orbital_transformation_matrices::orbtramat
type(orbtramat_type), dimension(:), pointer, public orbtramat
Definition orbital_transformation_matrices.F:47
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
paw_basis_types
Definition paw_basis_types.F:13
paw_basis_types::get_paw_basis_info
subroutine, public get_paw_basis_info(basis_1c, o2nindex, n2oindex, nsatbas)
Return some info on the PAW basis derived from a GTO basis set.
Definition paw_basis_types.F:40
paw_proj_set_types
Definition paw_proj_set_types.F:13
paw_proj_set_types::get_paw_proj_set
subroutine, public get_paw_proj_set(paw_proj_set, csprj, chprj, first_prj, first_prjs, last_prj, local_oce_sphi_h, local_oce_sphi_s, maxl, ncgauprj, nsgauprj, nsatbas, nsotot, nprj, o2nindex, n2oindex, rcprj, rzetprj, zisomin, zetprj)
Get informations about a paw projectors set.
Definition paw_proj_set_types.F:744
qs_kind_types
Define the quickstep kind type and their sub types.
Definition qs_kind_types.F:23
qs_kind_types::get_qs_kind
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, monovalent, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
Definition qs_kind_types.F:468
qs_kind_types::get_qs_kind_set
subroutine, public get_qs_kind_set(qs_kind_set, all_potential_present, tnadd_potential_present, gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, basis_rcut, basis_type, total_zeff_corr, npgf_seg, cneo_potential_present, nkind_q, natom_q)
Get attributes of an atomic kind set.
Definition qs_kind_types.F:913
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition qs_neighbor_list_types.F:17
qs_oce_methods
Routines for the construction of the coefficients for the expansion of the atomic densities rho1_hard...
Definition qs_oce_methods.F:16
qs_oce_methods::prj_gather
subroutine, public prj_gather(ain, aout, atom)
...
Definition qs_oce_methods.F:852
qs_oce_methods::build_oce_matrices
subroutine, public build_oce_matrices(intac, calculate_forces, nder, qs_kind_set, particle_set, sap_oce, eps_fit)
Set up the sparse matrix for the coefficients of one center expansions This routine uses the same log...
Definition qs_oce_methods.F:506
qs_oce_methods::proj_blk
subroutine, public proj_blk(h_a, s_a, na, h_b, s_b, nb, blk, ldb, proj_h, proj_s, nso, len1, len2, fac, distab, work1, work2)
Project a matrix block onto the local atomic functions.
Definition qs_oce_methods.F:803
qs_oce_methods::prj_scatter
subroutine, public prj_scatter(ain, aout, atom)
...
Definition qs_oce_methods.F:885
sap_kind_types
General overlap type integrals containers.
Definition sap_kind_types.F:12
sap_kind_types::sap_sort
subroutine, public sap_sort(sap_int)
...
Definition sap_kind_types.F:247
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72
block_p_types::block_p_type
Definition block_p_types.F:23
particle_types::particle_type
Definition particle_types.F:35
paw_proj_set_types::paw_proj_set_type
Definition paw_proj_set_types.F:52
qs_kind_types::qs_kind_type
Provides all information about a quickstep kind.
Definition qs_kind_types.F:177
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
sap_kind_types::clist_type
Definition sap_kind_types.F:43
sap_kind_types::sap_int_type
Definition sap_kind_types.F:64