53 USE dbcsr_api,
ONLY: dbcsr_copy, &
80 pw_integrate_function, &
85 pw_pools_create_pws, &
86 pw_pools_give_back_pws
89 pw_c1d_gs_type, pw_r3d_rs_type
99 realspace_grid_desc_p_type, &
100 realspace_grid_type, &
113 #include "./base/base_uses.f90"
119 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_collocate_density'
123 calculate_rho_core, &
128 calculate_rho_resp_all, &
137 INTERFACE calculate_rho_core
138 MODULE PROCEDURE calculate_rho_core_r3d_rs
139 MODULE PROCEDURE calculate_rho_core_c1d_gs
142 INTERFACE calculate_rho_resp_all
143 MODULE PROCEDURE calculate_rho_resp_all_r3d_rs, calculate_rho_resp_all_c1d_gs
155 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: rho_nlcc
156 TYPE(qs_environment_type),
POINTER :: qs_env
158 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_nlcc'
160 INTEGER :: atom_a, handle, iatom, iexp_nlcc, ikind, &
161 ithread, j, n, natom, nc, nexp_nlcc, &
162 ni, npme, nthread, subpatch_pattern
163 INTEGER,
DIMENSION(:),
POINTER :: atom_list, cores, nct_nlcc
165 REAL(kind=
dp) :: alpha, eps_rho_rspace, radius
166 REAL(kind=
dp),
DIMENSION(3) :: ra
167 REAL(kind=
dp),
DIMENSION(:),
POINTER :: alpha_nlcc
168 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: cval_nlcc, pab
169 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
170 TYPE(cell_type),
POINTER :: cell
171 TYPE(dft_control_type),
POINTER :: dft_control
172 TYPE(gth_potential_type),
POINTER :: gth_potential
173 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
174 TYPE(pw_env_type),
POINTER :: pw_env
175 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
176 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
177 TYPE(realspace_grid_type),
POINTER :: rs_rho
179 CALL timeset(routinen, handle)
181 NULLIFY (cell, dft_control, pab, particle_set, atomic_kind_set, &
182 qs_kind_set, atom_list, pw_env, rs_rho, auxbas_pw_pool, cores)
185 atomic_kind_set=atomic_kind_set, &
186 qs_kind_set=qs_kind_set, &
188 dft_control=dft_control, &
189 particle_set=particle_set, &
191 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
192 auxbas_pw_pool=auxbas_pw_pool)
196 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
198 DO ikind = 1,
SIZE(atomic_kind_set)
199 CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list)
200 CALL get_qs_kind(qs_kind_set(ikind), gth_potential=gth_potential)
202 IF (.NOT.
ASSOCIATED(gth_potential)) cycle
203 CALL get_potential(potential=gth_potential, nlcc_present=nlcc, nexp_nlcc=nexp_nlcc, &
204 alpha_nlcc=alpha_nlcc, nct_nlcc=nct_nlcc, cval_nlcc=cval_nlcc)
206 IF (.NOT. nlcc) cycle
208 DO iexp_nlcc = 1, nexp_nlcc
210 alpha = alpha_nlcc(iexp_nlcc)
211 nc = nct_nlcc(iexp_nlcc)
214 ALLOCATE (pab(ni, 1))
220 CALL reallocate(cores, 1, natom)
228 pab(1, 1) = cval_nlcc(1, iexp_nlcc)
231 pab(n, 1) = cval_nlcc(2, iexp_nlcc)/alpha**2
233 pab(n, 1) = cval_nlcc(2, iexp_nlcc)/alpha**2
235 pab(n, 1) = cval_nlcc(2, iexp_nlcc)/alpha**2
238 pab(n, 1) = cval_nlcc(3, iexp_nlcc)/alpha**4
240 pab(n, 1) = cval_nlcc(3, iexp_nlcc)/alpha**4
242 pab(n, 1) = cval_nlcc(3, iexp_nlcc)/alpha**4
244 pab(n, 1) = 2._dp*cval_nlcc(3, iexp_nlcc)/alpha**4
246 pab(n, 1) = 2._dp*cval_nlcc(3, iexp_nlcc)/alpha**4
248 pab(n, 1) = 2._dp*cval_nlcc(3, iexp_nlcc)/alpha**4
251 pab(n, 1) = cval_nlcc(4, iexp_nlcc)/alpha**6
253 pab(n, 1) = cval_nlcc(4, iexp_nlcc)/alpha**6
255 pab(n, 1) = cval_nlcc(4, iexp_nlcc)/alpha**6
257 pab(n, 1) = 3._dp*cval_nlcc(4, iexp_nlcc)/alpha**6
259 pab(n, 1) = 3._dp*cval_nlcc(4, iexp_nlcc)/alpha**6
261 pab(n, 1) = 3._dp*cval_nlcc(4, iexp_nlcc)/alpha**6
263 pab(n, 1) = 3._dp*cval_nlcc(4, iexp_nlcc)/alpha**6
265 pab(n, 1) = 3._dp*cval_nlcc(4, iexp_nlcc)/alpha**6
267 pab(n, 1) = 3._dp*cval_nlcc(4, iexp_nlcc)/alpha**6
269 pab(n, 1) = 6._dp*cval_nlcc(4, iexp_nlcc)/alpha**6
274 IF (dft_control%nspins == 2) pab = pab*0.5_dp
277 atom_a = atom_list(iatom)
278 ra(:) =
pbc(particle_set(atom_a)%r, cell)
279 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
281 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
294 atom_a = atom_list(iatom)
295 ra(:) =
pbc(particle_set(atom_a)%r, cell)
299 ra=ra, rb=ra, rp=ra, &
300 zetp=1/(2*alpha**2), eps=eps_rho_rspace, &
301 pab=pab, o1=0, o2=0, &
302 prefactor=1.0_dp, cutoff=0.0_dp)
305 (/0.0_dp, 0.0_dp, 0.0_dp/), 1.0_dp, pab, 0, 0, rs_rho, &
307 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
317 IF (
ASSOCIATED(cores))
THEN
323 CALL timestop(handle)
334 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: vppl
335 TYPE(qs_environment_type),
POINTER :: qs_env
337 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_ppl_grid'
339 INTEGER :: atom_a, handle, iatom, ikind, ithread, &
340 j, lppl, n, natom, ni, npme, nthread, &
342 INTEGER,
DIMENSION(:),
POINTER :: atom_list, cores
343 REAL(kind=
dp) :: alpha, eps_rho_rspace, radius
344 REAL(kind=
dp),
DIMENSION(3) :: ra
345 REAL(kind=
dp),
DIMENSION(:),
POINTER :: cexp_ppl
346 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
347 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
348 TYPE(cell_type),
POINTER :: cell
349 TYPE(dft_control_type),
POINTER :: dft_control
350 TYPE(gth_potential_type),
POINTER :: gth_potential
351 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
352 TYPE(pw_env_type),
POINTER :: pw_env
353 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
354 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
355 TYPE(realspace_grid_type),
POINTER :: rs_rho
357 CALL timeset(routinen, handle)
359 NULLIFY (cell, dft_control, pab, atomic_kind_set, qs_kind_set, particle_set, &
360 atom_list, pw_env, rs_rho, auxbas_pw_pool, cores)
363 atomic_kind_set=atomic_kind_set, &
364 qs_kind_set=qs_kind_set, &
366 dft_control=dft_control, &
367 particle_set=particle_set, &
369 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
370 auxbas_pw_pool=auxbas_pw_pool)
374 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
376 DO ikind = 1,
SIZE(atomic_kind_set)
377 CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list)
378 CALL get_qs_kind(qs_kind_set(ikind), gth_potential=gth_potential)
380 IF (.NOT.
ASSOCIATED(gth_potential)) cycle
381 CALL get_potential(potential=gth_potential, alpha_ppl=alpha, nexp_ppl=lppl, cexp_ppl=cexp_ppl)
386 ALLOCATE (pab(ni, 1))
392 CALL reallocate(cores, 1, natom)
400 pab(1, 1) = cexp_ppl(1)
403 pab(n, 1) = cexp_ppl(2)
405 pab(n, 1) = cexp_ppl(2)
407 pab(n, 1) = cexp_ppl(2)
410 pab(n, 1) = cexp_ppl(3)
412 pab(n, 1) = cexp_ppl(3)
414 pab(n, 1) = cexp_ppl(3)
416 pab(n, 1) = 2._dp*cexp_ppl(3)
418 pab(n, 1) = 2._dp*cexp_ppl(3)
420 pab(n, 1) = 2._dp*cexp_ppl(3)
423 pab(n, 1) = cexp_ppl(4)
425 pab(n, 1) = cexp_ppl(4)
427 pab(n, 1) = cexp_ppl(4)
429 pab(n, 1) = 3._dp*cexp_ppl(4)
431 pab(n, 1) = 3._dp*cexp_ppl(4)
433 pab(n, 1) = 3._dp*cexp_ppl(4)
435 pab(n, 1) = 3._dp*cexp_ppl(4)
437 pab(n, 1) = 3._dp*cexp_ppl(4)
439 pab(n, 1) = 3._dp*cexp_ppl(4)
441 pab(n, 1) = 6._dp*cexp_ppl(4)
448 atom_a = atom_list(iatom)
449 ra(:) =
pbc(particle_set(atom_a)%r, cell)
450 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
452 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
462 IF (npme .GT. 0)
THEN
466 atom_a = atom_list(iatom)
467 ra(:) =
pbc(particle_set(atom_a)%r, cell)
472 lb_min=0, lb_max=0, &
473 ra=ra, rb=ra, rp=ra, &
474 zetp=alpha, eps=eps_rho_rspace, &
475 pab=pab, o1=0, o2=0, &
476 prefactor=1.0_dp, cutoff=0.0_dp)
479 (/0.0_dp, 0.0_dp, 0.0_dp/), 1.0_dp, pab, 0, 0, rs_rho, &
481 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
490 IF (
ASSOCIATED(cores))
THEN
496 CALL timestop(handle)
516 lri_coef, total_rho, basis_type, exact_1c_terms, pmat, atomlist)
518 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: lri_rho_g
519 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: lri_rho_r
520 TYPE(qs_environment_type),
POINTER :: qs_env
521 TYPE(lri_kind_type),
DIMENSION(:),
POINTER :: lri_coef
522 REAL(kind=
dp),
INTENT(OUT) :: total_rho
523 CHARACTER(len=*),
INTENT(IN) :: basis_type
524 LOGICAL,
INTENT(IN) :: exact_1c_terms
525 TYPE(dbcsr_type),
OPTIONAL :: pmat
526 INTEGER,
DIMENSION(:),
OPTIONAL :: atomlist
528 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_lri_rho_elec'
530 INTEGER :: atom_a, group_size, handle, iatom, igrid_level, ikind, ipgf, iset, jpgf, jset, &
531 m1, maxco, maxsgf_set, my_pos, na1, natom, nb1, ncoa, ncob, nseta, offset, sgfa, sgfb
532 INTEGER,
DIMENSION(:),
POINTER :: atom_list, la_max, la_min, npgfa, nsgfa
533 INTEGER,
DIMENSION(:, :),
POINTER :: first_sgfa
535 LOGICAL,
ALLOCATABLE,
DIMENSION(:) :: map_it
536 LOGICAL,
ALLOCATABLE,
DIMENSION(:, :) :: map_it2
537 REAL(kind=
dp) :: eps_rho_rspace, radius, zetp
538 REAL(kind=
dp),
DIMENSION(3) :: ra
539 REAL(kind=
dp),
DIMENSION(:),
POINTER :: aci
540 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: p_block, pab, sphi_a, work, zeta
541 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
542 TYPE(cell_type),
POINTER :: cell
543 TYPE(dft_control_type),
POINTER :: dft_control
544 TYPE(gridlevel_info_type),
POINTER :: gridlevel_info
545 TYPE(gto_basis_set_type),
POINTER :: lri_basis_set, orb_basis_set
546 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
547 TYPE(pw_env_type),
POINTER :: pw_env
548 TYPE(pw_pool_p_type),
DIMENSION(:),
POINTER :: pw_pools
549 TYPE(pw_c1d_gs_type),
ALLOCATABLE,
DIMENSION(:) :: mgrid_gspace
550 TYPE(pw_r3d_rs_type),
ALLOCATABLE,
DIMENSION(:) :: mgrid_rspace
551 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
552 TYPE(realspace_grid_type),
DIMENSION(:),
POINTER :: rs_rho
553 TYPE(realspace_grid_type),
POINTER :: rs_grid
555 NULLIFY (aci, atomic_kind_set, qs_kind_set, atom_list, cell, &
556 dft_control, first_sgfa, gridlevel_info, la_max, &
557 la_min, lri_basis_set, npgfa, nsgfa, &
558 pab, particle_set, pw_env, pw_pools, rs_grid, rs_rho, sphi_a, &
561 CALL timeset(routinen, handle)
563 IF (exact_1c_terms)
THEN
564 cpassert(
PRESENT(pmat))
567 CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set, &
568 atomic_kind_set=atomic_kind_set, &
569 cell=cell, particle_set=particle_set, &
571 dft_control=dft_control)
573 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
574 gridlevel_info => pw_env%gridlevel_info
577 cpassert(
ASSOCIATED(pw_env))
578 CALL pw_env_get(pw_env=pw_env, rs_grids=rs_rho, pw_pools=pw_pools)
580 CALL pw_pools_create_pws(pw_pools, mgrid_rspace)
582 CALL pw_pools_create_pws(pw_pools, mgrid_gspace)
585 DO igrid_level = 1, gridlevel_info%ngrid_levels
591 maxco=maxco, basis_type=basis_type)
593 ALLOCATE (pab(maxco, 1))
595 my_pos = mgrid_rspace(1)%pw_grid%para%my_pos
596 group_size = mgrid_rspace(1)%pw_grid%para%group_size
598 DO ikind = 1,
SIZE(atomic_kind_set)
600 CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list)
601 CALL get_qs_kind(qs_kind_set(ikind), basis_set=lri_basis_set, basis_type=basis_type)
605 lmin=la_min, zet=zeta, nset=nseta, npgf=npgfa, &
606 sphi=sphi_a, first_sgf=first_sgfa, nsgf_set=nsgfa)
609 atom_a = atom_list(iatom)
610 IF (
PRESENT(atomlist))
THEN
611 IF (atomlist(atom_a) == 0) cycle
613 ra(:) =
pbc(particle_set(atom_a)%r, cell)
614 aci => lri_coef(ikind)%acoef(iatom, :)
616 m1 = maxval(npgfa(1:nseta))
617 ALLOCATE (map_it(m1))
621 DO ipgf = 1, npgfa(iset)
623 rs_grid => rs_rho(igrid_level)
624 map_it(ipgf) =
map_gaussian_here(rs_grid, cell%h_inv, ra, offset, group_size, my_pos)
628 IF (any(map_it(1:npgfa(iset))))
THEN
629 sgfa = first_sgfa(1, iset)
630 ncoa = npgfa(iset)*
ncoset(la_max(iset))
631 m1 = sgfa + nsgfa(iset) - 1
632 ALLOCATE (work(nsgfa(iset), 1))
633 work(1:nsgfa(iset), 1) = aci(sgfa:m1)
636 CALL dgemm(
"N",
"N", ncoa, 1, nsgfa(iset), 1.0_dp, lri_basis_set%sphi(1, sgfa), &
637 SIZE(lri_basis_set%sphi, 1), work(1, 1),
SIZE(work, 1), 0.0_dp, pab(1, 1), &
640 DO ipgf = 1, npgfa(iset)
641 na1 = (ipgf - 1)*
ncoset(la_max(iset))
643 rs_grid => rs_rho(igrid_level)
644 IF (map_it(ipgf))
THEN
646 lb_min=0, lb_max=0, &
647 ra=ra, rb=ra, rp=ra, &
648 zetp=zeta(ipgf, iset), eps=eps_rho_rspace, &
649 prefactor=1.0_dp, cutoff=1.0_dp)
652 zeta=zeta(ipgf, iset), &
653 la_min=la_min(iset), &
654 lb_max=0, zetb=0.0_dp, lb_min=0, &
655 ra=ra, rab=(/0.0_dp, 0.0_dp, 0.0_dp/), &
657 pab=pab, o1=na1, o2=0, &
673 IF (exact_1c_terms)
THEN
678 maxsgf_set=maxsgf_set, &
680 ALLOCATE (pab(maxco, maxco), work(maxco, maxsgf_set))
682 DO ikind = 1,
SIZE(atomic_kind_set)
683 CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list)
684 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, basis_type=
"ORB")
686 lmin=la_min, zet=zeta, nset=nseta, npgf=npgfa, &
687 sphi=sphi_a, first_sgf=first_sgfa, nsgf_set=nsgfa)
689 atom_a = atom_list(iatom)
690 ra(:) =
pbc(particle_set(atom_a)%r, cell)
691 CALL dbcsr_get_block_p(matrix=pmat, row=atom_a, col=atom_a, block=p_block, found=found)
692 m1 = maxval(npgfa(1:nseta))
693 ALLOCATE (map_it2(m1, m1))
698 DO ipgf = 1, npgfa(iset)
699 DO jpgf = 1, npgfa(jset)
700 zetp = zeta(ipgf, iset) + zeta(jpgf, jset)
702 rs_grid => rs_rho(igrid_level)
703 map_it2(ipgf, jpgf) =
map_gaussian_here(rs_grid, cell%h_inv, ra, offset, group_size, my_pos)
708 IF (any(map_it2(1:npgfa(iset), 1:npgfa(jset))))
THEN
709 ncoa = npgfa(iset)*
ncoset(la_max(iset))
710 sgfa = first_sgfa(1, iset)
711 ncob = npgfa(jset)*
ncoset(la_max(jset))
712 sgfb = first_sgfa(1, jset)
714 CALL dgemm(
"N",
"N", ncoa, nsgfa(jset), nsgfa(iset), &
715 1.0_dp, sphi_a(1, sgfa),
SIZE(sphi_a, 1), &
716 p_block(sgfa, sgfb),
SIZE(p_block, 1), &
717 0.0_dp, work(1, 1), maxco)
718 CALL dgemm(
"N",
"T", ncoa, ncob, nsgfa(jset), &
719 1.0_dp, work(1, 1), maxco, &
720 sphi_a(1, sgfb),
SIZE(sphi_a, 1), &
721 0.0_dp, pab(1, 1), maxco)
722 DO ipgf = 1, npgfa(iset)
723 DO jpgf = 1, npgfa(jset)
724 zetp = zeta(ipgf, iset) + zeta(jpgf, jset)
726 rs_grid => rs_rho(igrid_level)
728 na1 = (ipgf - 1)*
ncoset(la_max(iset))
729 nb1 = (jpgf - 1)*
ncoset(la_max(jset))
731 IF (map_it2(ipgf, jpgf))
THEN
733 la_max=la_max(iset), &
734 lb_min=la_min(jset), &
735 lb_max=la_max(jset), &
736 ra=ra, rb=ra, rp=ra, &
737 zetp=zetp, eps=eps_rho_rspace, &
738 prefactor=1.0_dp, cutoff=1.0_dp)
741 la_max(iset), zeta(ipgf, iset), la_min(iset), &
742 la_max(jset), zeta(jpgf, jset), la_min(jset), &
743 ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 1.0_dp, pab, na1, nb1, &
756 DEALLOCATE (pab, work)
759 CALL pw_zero(lri_rho_g)
760 CALL pw_zero(lri_rho_r)
762 DO igrid_level = 1, gridlevel_info%ngrid_levels
763 CALL pw_zero(mgrid_rspace(igrid_level))
765 pw=mgrid_rspace(igrid_level))
768 DO igrid_level = 1, gridlevel_info%ngrid_levels
769 CALL pw_zero(mgrid_gspace(igrid_level))
770 CALL pw_transfer(mgrid_rspace(igrid_level), &
771 mgrid_gspace(igrid_level))
772 CALL pw_axpy(mgrid_gspace(igrid_level), lri_rho_g)
774 CALL pw_transfer(lri_rho_g, lri_rho_r)
775 total_rho = pw_integrate_function(lri_rho_r, isign=-1)
778 CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
779 CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
781 CALL timestop(handle)
794 SUBROUTINE calculate_rho_core_r3d_rs (rho_core, total_rho, qs_env, calpha, ccore, only_nopaw)
796 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: rho_core
797 REAL(kind=
dp),
INTENT(OUT) :: total_rho
798 TYPE(qs_environment_type),
POINTER :: qs_env
799 REAL(kind=
dp),
DIMENSION(:),
OPTIONAL :: calpha, ccore
800 LOGICAL,
INTENT(IN),
OPTIONAL :: only_nopaw
802 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_core'
804 INTEGER :: atom_a, handle, iatom, ikind, ithread, &
805 j, natom, npme, nthread, &
807 INTEGER,
DIMENSION(:),
POINTER :: atom_list, cores
808 LOGICAL :: my_only_nopaw, paw_atom
809 REAL(kind=
dp) :: alpha, eps_rho_rspace, radius
810 REAL(kind=
dp),
DIMENSION(3) :: ra
811 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
812 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
813 TYPE(cell_type),
POINTER :: cell
814 TYPE(dft_control_type),
POINTER :: dft_control
815 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
816 TYPE(pw_env_type),
POINTER :: pw_env
817 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
818 TYPE(pw_r3d_rs_type) :: rhoc_r
819 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
820 TYPE(realspace_grid_type),
POINTER :: rs_rho
822 CALL timeset(routinen, handle)
823 NULLIFY (cell, dft_control, pab, atomic_kind_set, qs_kind_set, particle_set, &
824 atom_list, pw_env, rs_rho, auxbas_pw_pool, cores)
827 my_only_nopaw = .false.
828 IF (
PRESENT(only_nopaw)) my_only_nopaw = only_nopaw
829 IF (
PRESENT(calpha))
THEN
830 cpassert(
PRESENT(ccore))
834 atomic_kind_set=atomic_kind_set, &
835 qs_kind_set=qs_kind_set, &
837 dft_control=dft_control, &
838 particle_set=particle_set, &
840 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
841 auxbas_pw_pool=auxbas_pw_pool)
845 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
847 DO ikind = 1,
SIZE(atomic_kind_set)
848 CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list)
849 IF (
PRESENT(calpha))
THEN
850 alpha = calpha(ikind)
851 pab(1, 1) = ccore(ikind)
853 CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom, &
854 alpha_core_charge=alpha, ccore_charge=pab(1, 1))
857 IF (my_only_nopaw .AND. paw_atom) cycle
858 IF (alpha == 0.0_dp .OR. pab(1, 1) == 0.0_dp) cycle
863 CALL reallocate(cores, 1, natom)
868 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
870 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
880 IF (npme .GT. 0)
THEN
884 atom_a = atom_list(iatom)
885 ra(:) =
pbc(particle_set(atom_a)%r, cell)
888 lb_min=0, lb_max=0, &
889 ra=ra, rb=ra, rp=ra, &
890 zetp=alpha, eps=eps_rho_rspace, &
891 pab=pab, o1=0, o2=0, &
892 prefactor=-1.0_dp, cutoff=0.0_dp)
895 (/0.0_dp, 0.0_dp, 0.0_dp/), -1.0_dp, pab, 0, 0, rs_rho, &
897 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
904 IF (
ASSOCIATED(cores))
THEN
909 CALL auxbas_pw_pool%create_pw(rhoc_r)
913 total_rho = pw_integrate_function(rhoc_r, isign=-1)
915 CALL pw_transfer(rhoc_r, rho_core)
917 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
919 CALL timestop(handle)
921 END SUBROUTINE calculate_rho_core_r3d_rs
931 SUBROUTINE calculate_rho_core_c1d_gs (rho_core, total_rho, qs_env, calpha, ccore, only_nopaw)
933 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_core
934 REAL(kind=
dp),
INTENT(OUT) :: total_rho
935 TYPE(qs_environment_type),
POINTER :: qs_env
936 REAL(kind=
dp),
DIMENSION(:),
OPTIONAL :: calpha, ccore
937 LOGICAL,
INTENT(IN),
OPTIONAL :: only_nopaw
939 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_core'
941 INTEGER :: atom_a, handle, iatom, ikind, ithread, &
942 j, natom, npme, nthread, &
944 INTEGER,
DIMENSION(:),
POINTER :: atom_list, cores
945 LOGICAL :: my_only_nopaw, paw_atom
946 REAL(kind=
dp) :: alpha, eps_rho_rspace, radius
947 REAL(kind=
dp),
DIMENSION(3) :: ra
948 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
949 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
950 TYPE(cell_type),
POINTER :: cell
951 TYPE(dft_control_type),
POINTER :: dft_control
952 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
953 TYPE(pw_env_type),
POINTER :: pw_env
954 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
955 TYPE(pw_r3d_rs_type) :: rhoc_r
956 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
957 TYPE(realspace_grid_type),
POINTER :: rs_rho
959 CALL timeset(routinen, handle)
960 NULLIFY (cell, dft_control, pab, atomic_kind_set, qs_kind_set, particle_set, &
961 atom_list, pw_env, rs_rho, auxbas_pw_pool, cores)
964 my_only_nopaw = .false.
965 IF (
PRESENT(only_nopaw)) my_only_nopaw = only_nopaw
966 IF (
PRESENT(calpha))
THEN
967 cpassert(
PRESENT(ccore))
971 atomic_kind_set=atomic_kind_set, &
972 qs_kind_set=qs_kind_set, &
974 dft_control=dft_control, &
975 particle_set=particle_set, &
977 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
978 auxbas_pw_pool=auxbas_pw_pool)
982 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
984 DO ikind = 1,
SIZE(atomic_kind_set)
985 CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list)
986 IF (
PRESENT(calpha))
THEN
987 alpha = calpha(ikind)
988 pab(1, 1) = ccore(ikind)
990 CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom, &
991 alpha_core_charge=alpha, ccore_charge=pab(1, 1))
994 IF (my_only_nopaw .AND. paw_atom) cycle
995 IF (alpha == 0.0_dp .OR. pab(1, 1) == 0.0_dp) cycle
1000 CALL reallocate(cores, 1, natom)
1005 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
1007 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
1017 IF (npme .GT. 0)
THEN
1021 atom_a = atom_list(iatom)
1022 ra(:) =
pbc(particle_set(atom_a)%r, cell)
1023 subpatch_pattern = 0
1025 lb_min=0, lb_max=0, &
1026 ra=ra, rb=ra, rp=ra, &
1027 zetp=alpha, eps=eps_rho_rspace, &
1028 pab=pab, o1=0, o2=0, &
1029 prefactor=-1.0_dp, cutoff=0.0_dp)
1032 (/0.0_dp, 0.0_dp, 0.0_dp/), -1.0_dp, pab, 0, 0, rs_rho, &
1034 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
1041 IF (
ASSOCIATED(cores))
THEN
1046 CALL auxbas_pw_pool%create_pw(rhoc_r)
1050 total_rho = pw_integrate_function(rhoc_r, isign=-1)
1052 CALL pw_transfer(rhoc_r, rho_core)
1054 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
1056 CALL timestop(handle)
1058 END SUBROUTINE calculate_rho_core_c1d_gs
1071 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: drho_core
1072 TYPE(qs_environment_type),
POINTER :: qs_env
1073 INTEGER,
INTENT(IN) :: beta, lambda
1075 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_drho_core'
1077 INTEGER :: atom_a, dabqadb_func, handle, iatom, &
1078 ikind, ithread, j, natom, npme, &
1079 nthread, subpatch_pattern
1080 INTEGER,
DIMENSION(:),
POINTER :: atom_list, cores
1081 REAL(kind=
dp) :: alpha, eps_rho_rspace, radius
1082 REAL(kind=
dp),
DIMENSION(3) :: ra
1083 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
1084 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
1085 TYPE(cell_type),
POINTER :: cell
1086 TYPE(dft_control_type),
POINTER :: dft_control
1087 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
1088 TYPE(pw_env_type),
POINTER :: pw_env
1089 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
1090 TYPE(pw_r3d_rs_type) :: rhoc_r
1091 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
1092 TYPE(realspace_grid_type),
POINTER :: rs_rho
1094 CALL timeset(routinen, handle)
1095 NULLIFY (cell, dft_control, pab, atomic_kind_set, qs_kind_set, particle_set, &
1096 atom_list, pw_env, rs_rho, auxbas_pw_pool, cores)
1097 ALLOCATE (pab(1, 1))
1100 atomic_kind_set=atomic_kind_set, &
1101 qs_kind_set=qs_kind_set, &
1103 dft_control=dft_control, &
1104 particle_set=particle_set, &
1106 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
1107 auxbas_pw_pool=auxbas_pw_pool)
1111 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
1121 cpabort(
"invalid beta")
1123 DO ikind = 1,
SIZE(atomic_kind_set)
1124 CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list)
1126 alpha_core_charge=alpha, ccore_charge=pab(1, 1))
1128 IF (alpha == 0.0_dp .OR. pab(1, 1) == 0.0_dp) cycle
1133 CALL reallocate(cores, 1, natom)
1138 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
1140 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
1150 IF (npme .GT. 0)
THEN
1154 atom_a = atom_list(iatom)
1155 IF (atom_a /= lambda) cycle
1156 ra(:) =
pbc(particle_set(atom_a)%r, cell)
1157 subpatch_pattern = 0
1159 lb_min=0, lb_max=0, &
1160 ra=ra, rb=ra, rp=ra, &
1161 zetp=alpha, eps=eps_rho_rspace, &
1162 pab=pab, o1=0, o2=0, &
1163 prefactor=-1.0_dp, cutoff=0.0_dp)
1166 (/0.0_dp, 0.0_dp, 0.0_dp/), -1.0_dp, pab, 0, 0, rs_rho, &
1167 radius=radius, ga_gb_function=dabqadb_func, &
1168 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
1175 IF (
ASSOCIATED(cores))
THEN
1180 CALL auxbas_pw_pool%create_pw(rhoc_r)
1184 CALL pw_transfer(rhoc_r, drho_core)
1186 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
1188 CALL timestop(handle)
1203 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_gb
1204 TYPE(qs_environment_type),
POINTER :: qs_env
1205 INTEGER,
INTENT(IN) :: iatom_in
1207 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_single_gaussian'
1209 INTEGER :: atom_a, handle, iatom, npme, &
1211 REAL(kind=
dp) :: eps_rho_rspace, radius
1212 REAL(kind=
dp),
DIMENSION(3) :: ra
1213 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
1214 TYPE(cell_type),
POINTER :: cell
1215 TYPE(dft_control_type),
POINTER :: dft_control
1216 TYPE(pw_env_type),
POINTER :: pw_env
1217 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
1218 TYPE(pw_r3d_rs_type) :: rhoc_r
1219 TYPE(realspace_grid_type),
POINTER :: rs_rho
1221 CALL timeset(routinen, handle)
1222 NULLIFY (cell, dft_control, pab, pw_env, rs_rho, auxbas_pw_pool)
1224 ALLOCATE (pab(1, 1))
1228 dft_control=dft_control, &
1230 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
1231 auxbas_pw_pool=auxbas_pw_pool)
1234 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
1240 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
1241 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
1248 IF (npme .GT. 0)
THEN
1249 atom_a = qs_env%qmmm_env_qm%image_charge_pot%image_mm_list(iatom)
1250 ra(:) =
pbc(qs_env%qmmm_env_qm%image_charge_pot%particles_all(atom_a)%r, cell)
1251 subpatch_pattern = 0
1253 lb_min=0, lb_max=0, &
1254 ra=ra, rb=ra, rp=ra, &
1255 zetp=qs_env%qmmm_env_qm%image_charge_pot%eta, &
1256 eps=eps_rho_rspace, &
1257 pab=pab, o1=0, o2=0, &
1258 prefactor=1.0_dp, cutoff=0.0_dp)
1261 0, 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 1.0_dp, pab, 0, 0, rs_rho, &
1263 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
1268 CALL auxbas_pw_pool%create_pw(rhoc_r)
1272 CALL pw_transfer(rhoc_r, rho_gb)
1274 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
1276 CALL timestop(handle)
1293 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_metal
1294 REAL(kind=
dp),
DIMENSION(:),
POINTER :: coeff
1295 REAL(kind=
dp),
INTENT(OUT),
OPTIONAL :: total_rho_metal
1296 TYPE(qs_environment_type),
POINTER :: qs_env
1298 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_metal'
1300 INTEGER :: atom_a, handle, iatom, j, natom, npme, &
1302 INTEGER,
DIMENSION(:),
POINTER :: cores
1303 REAL(kind=
dp) :: eps_rho_rspace, radius
1304 REAL(kind=
dp),
DIMENSION(3) :: ra
1305 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
1306 TYPE(cell_type),
POINTER :: cell
1307 TYPE(dft_control_type),
POINTER :: dft_control
1308 TYPE(pw_env_type),
POINTER :: pw_env
1309 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
1310 TYPE(pw_r3d_rs_type) :: rhoc_r
1311 TYPE(realspace_grid_type),
POINTER :: rs_rho
1313 CALL timeset(routinen, handle)
1315 NULLIFY (cell, dft_control, pab, pw_env, rs_rho, auxbas_pw_pool, cores)
1317 ALLOCATE (pab(1, 1))
1321 dft_control=dft_control, &
1323 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
1324 auxbas_pw_pool=auxbas_pw_pool)
1327 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
1330 natom =
SIZE(qs_env%qmmm_env_qm%image_charge_pot%image_mm_list)
1332 CALL reallocate(cores, 1, natom)
1337 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
1338 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
1348 IF (npme .GT. 0)
THEN
1351 atom_a = qs_env%qmmm_env_qm%image_charge_pot%image_mm_list(iatom)
1352 ra(:) =
pbc(qs_env%qmmm_env_qm%image_charge_pot%particles_all(atom_a)%r, cell)
1353 subpatch_pattern = 0
1355 lb_min=0, lb_max=0, &
1356 ra=ra, rb=ra, rp=ra, &
1357 zetp=qs_env%qmmm_env_qm%image_charge_pot%eta, &
1358 eps=eps_rho_rspace, &
1359 pab=pab, o1=0, o2=0, &
1360 prefactor=coeff(iatom), cutoff=0.0_dp)
1363 0, qs_env%qmmm_env_qm%image_charge_pot%eta, &
1364 0, 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), coeff(iatom), pab, 0, 0, rs_rho, &
1366 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
1370 DEALLOCATE (pab, cores)
1372 CALL auxbas_pw_pool%create_pw(rhoc_r)
1376 IF (
PRESENT(total_rho_metal)) &
1378 total_rho_metal = pw_integrate_function(rhoc_r, isign=-1)
1380 CALL pw_transfer(rhoc_r, rho_metal)
1381 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
1383 CALL timestop(handle)
1399 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_gb
1400 TYPE(qs_environment_type),
POINTER :: qs_env
1401 REAL(kind=
dp),
INTENT(IN) :: eta
1402 INTEGER,
INTENT(IN) :: iatom_in
1404 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_resp_single'
1406 INTEGER :: handle, iatom, npme, subpatch_pattern
1407 REAL(kind=
dp) :: eps_rho_rspace, radius
1408 REAL(kind=
dp),
DIMENSION(3) :: ra
1409 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
1410 TYPE(cell_type),
POINTER :: cell
1411 TYPE(dft_control_type),
POINTER :: dft_control
1412 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
1413 TYPE(pw_env_type),
POINTER :: pw_env
1414 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
1415 TYPE(pw_r3d_rs_type) :: rhoc_r
1416 TYPE(realspace_grid_type),
POINTER :: rs_rho
1418 CALL timeset(routinen, handle)
1419 NULLIFY (cell, dft_control, pab, pw_env, rs_rho, auxbas_pw_pool, &
1422 ALLOCATE (pab(1, 1))
1426 dft_control=dft_control, &
1427 particle_set=particle_set, &
1429 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
1430 auxbas_pw_pool=auxbas_pw_pool)
1433 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
1439 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
1440 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
1447 IF (npme .GT. 0)
THEN
1448 ra(:) =
pbc(particle_set(iatom)%r, cell)
1449 subpatch_pattern = 0
1451 lb_min=0, lb_max=0, &
1452 ra=ra, rb=ra, rp=ra, &
1453 zetp=eta, eps=eps_rho_rspace, &
1454 pab=pab, o1=0, o2=0, &
1455 prefactor=1.0_dp, cutoff=0.0_dp)
1458 (/0.0_dp, 0.0_dp, 0.0_dp/), 1.0_dp, pab, 0, 0, rs_rho, &
1460 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
1465 CALL auxbas_pw_pool%create_pw(rhoc_r)
1469 CALL pw_transfer(rhoc_r, rho_gb)
1471 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
1473 CALL timestop(handle)
1489 SUBROUTINE calculate_rho_resp_all_r3d_rs (rho_resp, coeff, natom, eta, qs_env)
1491 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: rho_resp
1492 REAL(kind=
dp),
DIMENSION(:),
POINTER :: coeff
1493 INTEGER,
INTENT(IN) :: natom
1494 REAL(kind=
dp),
INTENT(IN) :: eta
1495 TYPE(qs_environment_type),
POINTER :: qs_env
1497 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_resp_all'
1499 INTEGER :: handle, iatom, j, npme, subpatch_pattern
1500 INTEGER,
DIMENSION(:),
POINTER :: cores
1501 REAL(kind=
dp) :: eps_rho_rspace, radius
1502 REAL(kind=
dp),
DIMENSION(3) :: ra
1503 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
1504 TYPE(cell_type),
POINTER :: cell
1505 TYPE(dft_control_type),
POINTER :: dft_control
1506 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
1507 TYPE(pw_env_type),
POINTER :: pw_env
1508 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
1509 TYPE(pw_r3d_rs_type) :: rhoc_r
1510 TYPE(realspace_grid_type),
POINTER :: rs_rho
1512 CALL timeset(routinen, handle)
1514 NULLIFY (cell, cores, dft_control, pab, pw_env, rs_rho, auxbas_pw_pool, &
1517 ALLOCATE (pab(1, 1))
1521 dft_control=dft_control, &
1522 particle_set=particle_set, &
1524 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
1525 auxbas_pw_pool=auxbas_pw_pool)
1528 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
1531 CALL reallocate(cores, 1, natom)
1536 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
1537 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
1547 IF (npme .GT. 0)
THEN
1550 ra(:) =
pbc(particle_set(iatom)%r, cell)
1551 subpatch_pattern = 0
1553 lb_min=0, lb_max=0, &
1554 ra=ra, rb=ra, rp=ra, &
1555 zetp=eta, eps=eps_rho_rspace, &
1556 pab=pab, o1=0, o2=0, &
1557 prefactor=coeff(iatom), cutoff=0.0_dp)
1561 0, 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), coeff(iatom), pab, 0, 0, rs_rho, &
1563 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
1567 DEALLOCATE (pab, cores)
1569 CALL auxbas_pw_pool%create_pw(rhoc_r)
1573 CALL pw_transfer(rhoc_r, rho_resp)
1574 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
1576 CALL timestop(handle)
1578 END SUBROUTINE calculate_rho_resp_all_r3d_rs
1591 SUBROUTINE calculate_rho_resp_all_c1d_gs (rho_resp, coeff, natom, eta, qs_env)
1593 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_resp
1594 REAL(kind=
dp),
DIMENSION(:),
POINTER :: coeff
1595 INTEGER,
INTENT(IN) :: natom
1596 REAL(kind=
dp),
INTENT(IN) :: eta
1597 TYPE(qs_environment_type),
POINTER :: qs_env
1599 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_resp_all'
1601 INTEGER :: handle, iatom, j, npme, subpatch_pattern
1602 INTEGER,
DIMENSION(:),
POINTER :: cores
1603 REAL(kind=
dp) :: eps_rho_rspace, radius
1604 REAL(kind=
dp),
DIMENSION(3) :: ra
1605 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab
1606 TYPE(cell_type),
POINTER :: cell
1607 TYPE(dft_control_type),
POINTER :: dft_control
1608 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
1609 TYPE(pw_env_type),
POINTER :: pw_env
1610 TYPE(pw_pool_type),
POINTER :: auxbas_pw_pool
1611 TYPE(pw_r3d_rs_type) :: rhoc_r
1612 TYPE(realspace_grid_type),
POINTER :: rs_rho
1614 CALL timeset(routinen, handle)
1616 NULLIFY (cell, cores, dft_control, pab, pw_env, rs_rho, auxbas_pw_pool, &
1619 ALLOCATE (pab(1, 1))
1623 dft_control=dft_control, &
1624 particle_set=particle_set, &
1626 CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, &
1627 auxbas_pw_pool=auxbas_pw_pool)
1630 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
1633 CALL reallocate(cores, 1, natom)
1638 IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed)
THEN
1639 IF (
modulo(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos)
THEN
1649 IF (npme .GT. 0)
THEN
1652 ra(:) =
pbc(particle_set(iatom)%r, cell)
1653 subpatch_pattern = 0
1655 lb_min=0, lb_max=0, &
1656 ra=ra, rb=ra, rp=ra, &
1657 zetp=eta, eps=eps_rho_rspace, &
1658 pab=pab, o1=0, o2=0, &
1659 prefactor=coeff(iatom), cutoff=0.0_dp)
1663 0, 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), coeff(iatom), pab, 0, 0, rs_rho, &
1665 use_subpatch=.true., subpatch_pattern=subpatch_pattern)
1669 DEALLOCATE (pab, cores)
1671 CALL auxbas_pw_pool%create_pw(rhoc_r)
1675 CALL pw_transfer(rhoc_r, rho_resp)
1676 CALL auxbas_pw_pool%give_back_pw(rhoc_r)
1678 CALL timestop(handle)
1680 END SUBROUTINE calculate_rho_resp_all_c1d_gs
1708 ks_env, soft_valid, compute_tau, compute_grad, &
1709 basis_type, der_type, idir, task_list_external, pw_env_external)
1711 TYPE(dbcsr_type),
OPTIONAL,
TARGET :: matrix_p
1712 TYPE(dbcsr_p_type),
DIMENSION(:),
OPTIONAL, &
1713 POINTER :: matrix_p_kp
1714 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: rho
1715 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_gspace
1716 REAL(kind=
dp),
INTENT(OUT),
OPTIONAL :: total_rho
1717 TYPE(qs_ks_env_type),
POINTER :: ks_env
1718 LOGICAL,
INTENT(IN),
OPTIONAL :: soft_valid, compute_tau, compute_grad
1719 CHARACTER(LEN=*),
INTENT(IN),
OPTIONAL :: basis_type
1720 INTEGER,
INTENT(IN),
OPTIONAL :: der_type, idir
1721 TYPE(task_list_type),
OPTIONAL,
POINTER :: task_list_external
1722 TYPE(pw_env_type),
OPTIONAL,
POINTER :: pw_env_external
1724 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_rho_elec'
1726 CHARACTER(LEN=default_string_length) :: my_basis_type
1727 INTEGER :: ga_gb_function, handle, ilevel, img, &
1729 LOGICAL :: any_distributed, my_compute_grad, &
1730 my_compute_tau, my_soft_valid
1731 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_images
1732 TYPE(dft_control_type),
POINTER :: dft_control
1733 TYPE(mp_comm_type) :: group
1734 TYPE(pw_env_type),
POINTER :: pw_env
1735 TYPE(realspace_grid_type),
DIMENSION(:),
POINTER :: rs_rho
1736 TYPE(task_list_type),
POINTER :: task_list
1738 CALL timeset(routinen, handle)
1740 NULLIFY (matrix_images, dft_control, pw_env, rs_rho, task_list)
1743 my_compute_tau = .false.
1744 IF (
PRESENT(compute_tau)) my_compute_tau = compute_tau
1745 my_compute_grad = .false.
1746 IF (
PRESENT(compute_grad)) my_compute_grad = compute_grad
1747 IF (
PRESENT(der_type))
THEN
1748 SELECT CASE (der_type)
1770 cpabort(
"Unknown der_type")
1772 ELSE IF (my_compute_tau)
THEN
1774 ELSE IF (my_compute_grad)
THEN
1775 cpassert(
PRESENT(idir))
1784 cpabort(
"invalid idir")
1791 my_basis_type =
"ORB"
1792 IF (
PRESENT(basis_type)) my_basis_type = basis_type
1793 cpassert(my_basis_type ==
"ORB" .OR.
PRESENT(task_list_external))
1796 my_soft_valid = .false.
1797 IF (
PRESENT(soft_valid)) my_soft_valid = soft_valid
1798 IF (
PRESENT(task_list_external))
THEN
1799 task_list => task_list_external
1800 ELSEIF (my_soft_valid)
THEN
1801 CALL get_ks_env(ks_env, task_list_soft=task_list)
1805 cpassert(
ASSOCIATED(task_list))
1808 IF (
PRESENT(pw_env_external))
THEN
1809 pw_env => pw_env_external
1813 cpassert(
ASSOCIATED(pw_env))
1817 nlevels =
SIZE(rs_rho)
1818 group = rs_rho(1)%desc%group
1821 any_distributed = .false.
1822 DO ilevel = 1, nlevels
1823 any_distributed = any_distributed .OR. rs_rho(ilevel)%desc%distributed
1827 CALL get_ks_env(ks_env, dft_control=dft_control)
1828 nimages = dft_control%nimages
1829 ALLOCATE (matrix_images(nimages))
1830 IF (
PRESENT(matrix_p_kp))
THEN
1831 cpassert(.NOT.
PRESENT(matrix_p))
1833 matrix_images(img)%matrix => matrix_p_kp(img)%matrix
1836 cpassert(
PRESENT(matrix_p) .AND. nimages == 1)
1837 matrix_images(1)%matrix => matrix_p
1841 IF (any_distributed)
THEN
1846 DEALLOCATE (matrix_images)
1850 ga_gb_function=ga_gb_function, &
1851 pab_blocks=task_list%pab_buffer, &
1856 IF (
PRESENT(total_rho)) total_rho = pw_integrate_function(rho, isign=-1)
1858 CALL timestop(handle)
1875 soft_valid, basis_type)
1877 TYPE(dbcsr_type),
OPTIONAL,
TARGET :: matrix_p
1878 TYPE(dbcsr_p_type),
DIMENSION(:),
OPTIONAL, &
1879 POINTER :: matrix_p_kp
1880 TYPE(pw_r3d_rs_type),
DIMENSION(3),
INTENT(INOUT) :: drho
1881 TYPE(pw_c1d_gs_type),
DIMENSION(3),
INTENT(INOUT) :: drho_gspace
1882 TYPE(qs_environment_type),
POINTER :: qs_env
1883 LOGICAL,
INTENT(IN),
OPTIONAL :: soft_valid
1884 CHARACTER(LEN=*),
INTENT(IN),
OPTIONAL :: basis_type
1886 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_drho_elec'
1888 CHARACTER(LEN=default_string_length) :: my_basis_type
1889 INTEGER :: bcol, brow, dabqadb_func, handle, iatom, iatom_old, idir, igrid_level, ikind, &
1890 ikind_old, img, img_old, ipgf, iset, iset_old, itask, ithread, jatom, jatom_old, jkind, &
1891 jkind_old, jpgf, jset, jset_old, maxco, maxsgf_set, na1, na2, natoms, nb1, nb2, ncoa, &
1892 ncob, nimages, nseta, nsetb, ntasks, nthread, sgfa, sgfb
1893 INTEGER,
DIMENSION(:),
POINTER :: la_max, la_min, lb_max, lb_min, npgfa, &
1895 INTEGER,
DIMENSION(:, :),
POINTER :: first_sgfa, first_sgfb
1896 LOGICAL :: atom_pair_changed, distributed_rs_grids, &
1897 do_kp, found, my_soft, use_subpatch
1898 REAL(kind=
dp) :: eps_rho_rspace, f, prefactor, radius, &
1900 REAL(kind=
dp),
DIMENSION(3) :: ra, rab, rab_inv, rb, rp
1901 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: p_block, pab, sphi_a, sphi_b, work, &
1903 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: pabt, workt
1904 TYPE(atom_pair_type),
DIMENSION(:),
POINTER :: atom_pair_recv, atom_pair_send
1905 TYPE(cell_type),
POINTER :: cell
1906 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: deltap
1907 TYPE(dft_control_type),
POINTER :: dft_control
1908 TYPE(gridlevel_info_type),
POINTER :: gridlevel_info
1909 TYPE(gto_basis_set_type),
POINTER :: orb_basis_set
1910 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
1912 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
1913 TYPE(pw_env_type),
POINTER :: pw_env
1914 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
1915 TYPE(realspace_grid_desc_p_type),
DIMENSION(:), &
1917 TYPE(realspace_grid_type),
DIMENSION(:),
POINTER :: rs_rho
1918 TYPE(task_list_type),
POINTER :: task_list, task_list_soft
1919 TYPE(task_type),
DIMENSION(:),
POINTER :: tasks
1921 CALL timeset(routinen, handle)
1923 cpassert(
PRESENT(matrix_p) .OR.
PRESENT(matrix_p_kp))
1924 do_kp =
PRESENT(matrix_p_kp)
1926 NULLIFY (cell, dft_control, orb_basis_set, deltap, qs_kind_set, &
1927 sab_orb, particle_set, rs_rho, pw_env, rs_descs, la_max, la_min, &
1928 lb_max, lb_min, npgfa, npgfb, nsgfa, nsgfb, p_block, sphi_a, &
1929 sphi_b, zeta, zetb, first_sgfa, first_sgfb, tasks, pabt, workt)
1933 IF (
PRESENT(soft_valid)) my_soft = soft_valid
1935 IF (
PRESENT(basis_type))
THEN
1936 my_basis_type = basis_type
1938 my_basis_type =
"ORB"
1942 qs_kind_set=qs_kind_set, &
1944 dft_control=dft_control, &
1945 particle_set=particle_set, &
1949 SELECT CASE (my_basis_type)
1952 task_list=task_list, &
1953 task_list_soft=task_list_soft)
1956 task_list_soft=task_list_soft)
1957 CALL get_admm_env(qs_env%admm_env, task_list_aux_fit=task_list)
1961 gridlevel_info => pw_env%gridlevel_info
1967 maxsgf_set=maxsgf_set, &
1968 basis_type=my_basis_type)
1969 CALL reallocate(pabt, 1, maxco, 1, maxco, 0, nthread - 1)
1970 CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread - 1)
1973 nimages = dft_control%nimages
1974 cpassert(nimages == 1 .OR. do_kp)
1976 natoms =
SIZE(particle_set)
1979 IF (my_soft) task_list => task_list_soft
1980 cpassert(
ASSOCIATED(task_list))
1981 tasks => task_list%tasks
1982 atom_pair_send => task_list%atom_pair_send
1983 atom_pair_recv => task_list%atom_pair_recv
1984 ntasks = task_list%ntasks
1987 cpassert(
ASSOCIATED(pw_env))
1988 CALL pw_env_get(pw_env, rs_descs=rs_descs, rs_grids=rs_rho)
1989 DO igrid_level = 1, gridlevel_info%ngrid_levels
1990 distributed_rs_grids = rs_rho(igrid_level)%desc%distributed
1993 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
1998 ALLOCATE (deltap(nimages))
1999 IF (distributed_rs_grids)
THEN
2006 CALL dbcsr_copy(deltap(img)%matrix, matrix_p_kp(img)%matrix, &
2010 CALL dbcsr_copy(deltap(1)%matrix, matrix_p, name=
"DeltaP")
2015 deltap(img)%matrix => matrix_p_kp(img)%matrix
2018 deltap(1)%matrix => matrix_p
2023 IF (distributed_rs_grids)
THEN
2025 atom_pair_send=atom_pair_send, atom_pair_recv=atom_pair_recv, &
2026 nimages=nimages, scatter=.true.)
2032 pab => pabt(:, :, ithread)
2033 work => workt(:, :, ithread)
2035 loop_xyz:
DO idir = 1, 3
2037 DO igrid_level = 1, gridlevel_info%ngrid_levels
2041 iatom_old = -1; jatom_old = -1; iset_old = -1; jset_old = -1
2042 ikind_old = -1; jkind_old = -1; img_old = -1
2043 loop_tasks:
DO itask = 1, ntasks
2046 igrid_level = tasks(itask)%grid_level
2047 img = tasks(itask)%image
2048 iatom = tasks(itask)%iatom
2049 jatom = tasks(itask)%jatom
2050 iset = tasks(itask)%iset
2051 jset = tasks(itask)%jset
2052 ipgf = tasks(itask)%ipgf
2053 jpgf = tasks(itask)%jpgf
2055 ikind = particle_set(iatom)%atomic_kind%kind_number
2056 jkind = particle_set(jatom)%atomic_kind%kind_number
2058 IF (iatom .NE. iatom_old .OR. jatom .NE. jatom_old .OR. img .NE. img_old)
THEN
2060 IF (iatom .NE. iatom_old) ra(:) =
pbc(particle_set(iatom)%r, cell)
2062 IF (iatom <= jatom)
THEN
2070 IF (ikind .NE. ikind_old)
THEN
2072 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, &
2073 basis_type=
"ORB_SOFT")
2075 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, &
2076 basis_type=my_basis_type)
2079 first_sgf=first_sgfa, &
2089 IF (jkind .NE. jkind_old)
THEN
2091 CALL get_qs_kind(qs_kind_set(jkind), basis_set=orb_basis_set, &
2092 basis_type=
"ORB_SOFT")
2094 CALL get_qs_kind(qs_kind_set(jkind), basis_set=orb_basis_set, &
2095 basis_type=my_basis_type)
2098 first_sgf=first_sgfb, &
2108 CALL dbcsr_get_block_p(matrix=deltap(img)%matrix, &
2109 row=brow, col=bcol, block=p_block, found=found)
2117 atom_pair_changed = .true.
2121 atom_pair_changed = .false.
2125 IF (atom_pair_changed .OR. iset_old .NE. iset .OR. jset_old .NE. jset)
THEN
2127 ncoa = npgfa(iset)*
ncoset(la_max(iset))
2128 sgfa = first_sgfa(1, iset)
2129 ncob = npgfb(jset)*
ncoset(lb_max(jset))
2130 sgfb = first_sgfb(1, jset)
2132 IF (iatom <= jatom)
THEN
2133 CALL dgemm(
"N",
"N", ncoa, nsgfb(jset), nsgfa(iset), &
2134 1.0_dp, sphi_a(1, sgfa),
SIZE(sphi_a, 1), &
2135 p_block(sgfa, sgfb),
SIZE(p_block, 1), &
2136 0.0_dp, work(1, 1), maxco)
2137 CALL dgemm(
"N",
"T", ncoa, ncob, nsgfb(jset), &
2138 1.0_dp, work(1, 1), maxco, &
2139 sphi_b(1, sgfb),
SIZE(sphi_b, 1), &
2140 0.0_dp, pab(1, 1), maxco)
2142 CALL dgemm(
"N",
"N", ncob, nsgfa(iset), nsgfb(jset), &
2143 1.0_dp, sphi_b(1, sgfb),
SIZE(sphi_b, 1), &
2144 p_block(sgfb, sgfa),
SIZE(p_block, 1), &
2145 0.0_dp, work(1, 1), maxco)
2146 CALL dgemm(
"N",
"T", ncob, ncoa, nsgfa(iset), &
2147 1.0_dp, work(1, 1), maxco, &
2148 sphi_a(1, sgfa),
SIZE(sphi_a, 1), &
2149 0.0_dp, pab(1, 1), maxco)
2157 rab(:) = tasks(itask)%rab
2158 rb(:) = ra(:) + rab(:)
2159 zetp = zeta(ipgf, iset) + zetb(jpgf, jset)
2161 f = zetb(jpgf, jset)/zetp
2162 rp(:) = ra(:) + f*rab(:)
2163 prefactor = exp(-zeta(ipgf, iset)*f*dot_product(rab, rab))
2165 lb_min=lb_min(jset), lb_max=lb_max(jset), &
2166 ra=ra, rb=rb, rp=rp, &
2167 zetp=zeta(ipgf, iset), eps=eps_rho_rspace, &
2168 prefactor=prefactor, cutoff=1.0_dp)
2170 na1 = (ipgf - 1)*
ncoset(la_max(iset)) + 1
2171 na2 = ipgf*
ncoset(la_max(iset))
2172 nb1 = (jpgf - 1)*
ncoset(lb_max(jset)) + 1
2173 nb2 = jpgf*
ncoset(lb_max(jset))
2176 IF (iatom == jatom .AND. img == 1)
THEN
2183 IF (rs_rho(igrid_level)%desc%distributed)
THEN
2185 IF (tasks(itask)%dist_type .EQ. 2)
THEN
2186 use_subpatch = .true.
2188 use_subpatch = .false.
2191 use_subpatch = .false.
2202 cpabort(
"invalid idir")
2205 IF (iatom <= jatom)
THEN
2207 la_max(iset), zeta(ipgf, iset), la_min(iset), &
2208 lb_max(jset), zetb(jpgf, jset), lb_min(jset), &
2209 ra, rab, scale, pab, na1 - 1, nb1 - 1, &
2210 rs_rho(igrid_level), &
2211 radius=radius, ga_gb_function=dabqadb_func, &
2212 use_subpatch=use_subpatch, subpatch_pattern=tasks(itask)%subpatch_pattern)
2216 lb_max(jset), zetb(jpgf, jset), lb_min(jset), &
2217 la_max(iset), zeta(ipgf, iset), la_min(iset), &
2218 rb, rab_inv, scale, pab, nb1 - 1, na1 - 1, &
2219 rs_rho(igrid_level), &
2220 radius=radius, ga_gb_function=dabqadb_func, &
2221 use_subpatch=use_subpatch, subpatch_pattern=tasks(itask)%subpatch_pattern)
2226 CALL density_rs2pw(pw_env, rs_rho, drho(idir), drho_gspace(idir))
2231 IF (distributed_rs_grids)
THEN
2235 NULLIFY (deltap(img)%matrix)
2240 DEALLOCATE (pabt, workt)
2242 CALL timestop(handle)
2262 soft_valid, basis_type, beta, lambda)
2264 TYPE(dbcsr_type),
OPTIONAL,
TARGET :: matrix_p
2265 TYPE(dbcsr_p_type),
DIMENSION(:),
OPTIONAL, &
2266 POINTER :: matrix_p_kp
2267 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: drho
2268 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: drho_gspace
2269 TYPE(qs_environment_type),
POINTER :: qs_env
2270 LOGICAL,
INTENT(IN),
OPTIONAL :: soft_valid
2271 CHARACTER(LEN=*),
INTENT(IN),
OPTIONAL :: basis_type
2272 INTEGER,
INTENT(IN) :: beta, lambda
2274 CHARACTER(len=*),
PARAMETER :: routinen =
'calculate_drho_elec_dR'
2276 CHARACTER(LEN=default_string_length) :: my_basis_type
2277 INTEGER :: bcol, brow, dabqadb_func, handle, iatom, iatom_old, igrid_level, ikind, &
2278 ikind_old, img, img_old, ipgf, iset, iset_old, itask, ithread, jatom, jatom_old, jkind, &
2279 jkind_old, jpgf, jset, jset_old, maxco, maxsgf_set, na1, na2, natoms, nb1, nb2, ncoa, &
2280 ncob, nimages, nseta, nsetb, ntasks, nthread, sgfa, sgfb
2281 INTEGER,
DIMENSION(:),
POINTER :: la_max, la_min, lb_max, lb_min, npgfa, &
2283 INTEGER,
DIMENSION(:, :),
POINTER :: first_sgfa, first_sgfb
2284 LOGICAL :: atom_pair_changed, distributed_rs_grids, &
2285 do_kp, found, my_soft, use_subpatch
2286 REAL(kind=
dp) :: eps_rho_rspace, f, prefactor, radius, &
2288 REAL(kind=
dp),
DIMENSION(3) :: ra, rab, rab_inv, rb, rp
2289 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: p_block, pab, sphi_a, sphi_b, work, &
2291 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: pabt, workt
2292 TYPE(atom_pair_type),
DIMENSION(:),
POINTER :: atom_pair_recv, atom_pair_send
2293 TYPE(cell_type),
POINTER :: cell
2294 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: deltap
2295 TYPE(dft_control_type),
POINTER :: dft_control
2296 TYPE(gridlevel_info_type),
POINTER :: gridlevel_info
2297 TYPE(gto_basis_set_type),
POINTER :: orb_basis_set
2298 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
2299 TYPE(pw_env_type),
POINTER :: pw_env
2300 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
2301 TYPE(realspace_grid_desc_p_type),
DIMENSION(:), &
2303 TYPE(realspace_grid_type),
DIMENSION(:),
POINTER :: rs_rho
2304 TYPE(task_list_type),
POINTER :: task_list, task_list_soft
2305 TYPE(task_type),
DIMENSION(:),
POINTER :: tasks
2307 CALL timeset(routinen, handle)
2309 cpassert(
PRESENT(matrix_p) .OR.
PRESENT(matrix_p_kp))
2310 do_kp =
PRESENT(matrix_p_kp)
2312 NULLIFY (cell, dft_control, orb_basis_set, deltap, qs_kind_set, &
2313 particle_set, rs_rho, pw_env, rs_descs, la_max, la_min, lb_max, &
2314 lb_min, npgfa, npgfb, nsgfa, nsgfb, p_block, sphi_a, sphi_b, &
2315 zeta, zetb, first_sgfa, first_sgfb, tasks, pabt, workt)
2319 IF (
PRESENT(soft_valid)) my_soft = soft_valid
2321 IF (
PRESENT(basis_type))
THEN
2322 my_basis_type = basis_type
2324 my_basis_type =
"ORB"
2328 qs_kind_set=qs_kind_set, &
2330 dft_control=dft_control, &
2331 particle_set=particle_set, &
2334 SELECT CASE (my_basis_type)
2337 task_list=task_list, &
2338 task_list_soft=task_list_soft)
2341 task_list_soft=task_list_soft)
2342 CALL get_admm_env(qs_env%admm_env, task_list_aux_fit=task_list)
2346 gridlevel_info => pw_env%gridlevel_info
2352 maxsgf_set=maxsgf_set, &
2353 basis_type=my_basis_type)
2354 CALL reallocate(pabt, 1, maxco, 1, maxco, 0, nthread - 1)
2355 CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread - 1)
2358 nimages = dft_control%nimages
2359 cpassert(nimages == 1 .OR. do_kp)
2361 natoms =
SIZE(particle_set)
2364 IF (my_soft) task_list => task_list_soft
2365 cpassert(
ASSOCIATED(task_list))
2366 tasks => task_list%tasks
2367 atom_pair_send => task_list%atom_pair_send
2368 atom_pair_recv => task_list%atom_pair_recv
2369 ntasks = task_list%ntasks
2372 cpassert(
ASSOCIATED(pw_env))
2373 CALL pw_env_get(pw_env, rs_descs=rs_descs, rs_grids=rs_rho)
2374 DO igrid_level = 1, gridlevel_info%ngrid_levels
2375 distributed_rs_grids = rs_rho(igrid_level)%desc%distributed
2378 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
2383 ALLOCATE (deltap(nimages))
2384 IF (distributed_rs_grids)
THEN
2391 CALL dbcsr_copy(deltap(img)%matrix, matrix_p_kp(img)%matrix, &
2395 CALL dbcsr_copy(deltap(1)%matrix, matrix_p, name=
"DeltaP")
2400 deltap(img)%matrix => matrix_p_kp(img)%matrix
2403 deltap(1)%matrix => matrix_p
2408 IF (distributed_rs_grids)
THEN
2410 atom_pair_send=atom_pair_send, atom_pair_recv=atom_pair_recv, &
2411 nimages=nimages, scatter=.true.)
2417 pab => pabt(:, :, ithread)
2418 work => workt(:, :, ithread)
2420 DO igrid_level = 1, gridlevel_info%ngrid_levels
2424 iatom_old = -1; jatom_old = -1; iset_old = -1; jset_old = -1
2425 ikind_old = -1; jkind_old = -1; img_old = -1
2426 loop_tasks:
DO itask = 1, ntasks
2429 igrid_level = tasks(itask)%grid_level
2430 img = tasks(itask)%image
2431 iatom = tasks(itask)%iatom
2432 jatom = tasks(itask)%jatom
2433 iset = tasks(itask)%iset
2434 jset = tasks(itask)%jset
2435 ipgf = tasks(itask)%ipgf
2436 jpgf = tasks(itask)%jpgf
2438 ikind = particle_set(iatom)%atomic_kind%kind_number
2439 jkind = particle_set(jatom)%atomic_kind%kind_number
2441 IF (iatom .NE. iatom_old .OR. jatom .NE. jatom_old .OR. img .NE. img_old)
THEN
2443 IF (iatom .NE. iatom_old) ra(:) =
pbc(particle_set(iatom)%r, cell)
2445 IF (iatom <= jatom)
THEN
2453 IF (ikind .NE. ikind_old)
THEN
2455 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, &
2456 basis_type=
"ORB_SOFT")
2458 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, &
2459 basis_type=my_basis_type)
2462 first_sgf=first_sgfa, &
2472 IF (jkind .NE. jkind_old)
THEN
2474 CALL get_qs_kind(qs_kind_set(jkind), basis_set=orb_basis_set, &
2475 basis_type=
"ORB_SOFT")
2477 CALL get_qs_kind(qs_kind_set(jkind), basis_set=orb_basis_set, &
2478 basis_type=my_basis_type)
2481 first_sgf=first_sgfb, &
2491 CALL dbcsr_get_block_p(matrix=deltap(img)%matrix, &
2492 row=brow, col=bcol, block=p_block, found=found)
2500 atom_pair_changed = .true.
2504 atom_pair_changed = .false.
2508 IF (atom_pair_changed .OR. iset_old .NE. iset .OR. jset_old .NE. jset)
THEN
2510 ncoa = npgfa(iset)*
ncoset(la_max(iset))
2511 sgfa = first_sgfa(1, iset)
2512 ncob = npgfb(jset)*
ncoset(lb_max(jset))
2513 sgfb = first_sgfb(1, jset)
2515 IF (iatom <= jatom)
THEN
2516 CALL dgemm(
"N",
"N", ncoa, nsgfb(jset), nsgfa(iset), &
2517 1.0_dp, sphi_a(1, sgfa),
SIZE(sphi_a, 1), &
2518 p_block(sgfa, sgfb),
SIZE(p_block, 1), &
2519 0.0_dp, work(1, 1), maxco)
2520 CALL dgemm(
"N",
"T", ncoa, ncob, nsgfb(jset), &
2521 1.0_dp, work(1, 1), maxco, &
2522 sphi_b(1, sgfb),
SIZE(sphi_b, 1), &
2523 0.0_dp, pab(1, 1), maxco)
2525 CALL dgemm(
"N",
"N", ncob, nsgfa(iset), nsgfb(jset), &
2526 1.0_dp, sphi_b(1, sgfb),
SIZE(sphi_b, 1), &
2527 p_block(sgfb, sgfa),
SIZE(p_block, 1), &
2528 0.0_dp, work(1, 1), maxco)
2529 CALL dgemm(
"N",
"T", ncob, ncoa, nsgfa(iset), &
2530 1.0_dp, work(1, 1), maxco, &
2531 sphi_a(1, sgfa),
SIZE(sphi_a, 1), &
2532 0.0_dp, pab(1, 1), maxco)
2540 rab(:) = tasks(itask)%rab
2541 rb(:) = ra(:) + rab(:)
2542 zetp = zeta(ipgf, iset) + zetb(jpgf, jset)
2544 f = zetb(jpgf, jset)/zetp
2545 rp(:) = ra(:) + f*rab(:)
2546 prefactor = exp(-zeta(ipgf, iset)*f*dot_product(rab, rab))
2548 lb_min=lb_min(jset), lb_max=lb_max(jset), &
2549 ra=ra, rb=rb, rp=rp, &
2550 zetp=zetp, eps=eps_rho_rspace, &
2551 prefactor=prefactor, cutoff=1.0_dp)
2553 na1 = (ipgf - 1)*
ncoset(la_max(iset)) + 1
2554 na2 = ipgf*
ncoset(la_max(iset))
2555 nb1 = (jpgf - 1)*
ncoset(lb_max(jset)) + 1
2556 nb2 = jpgf*
ncoset(lb_max(jset))
2559 IF (iatom == jatom .AND. img == 1)
THEN
2566 IF (rs_rho(igrid_level)%desc%distributed)
THEN
2568 IF (tasks(itask)%dist_type .EQ. 2)
THEN
2569 use_subpatch = .true.
2571 use_subpatch = .false.
2574 use_subpatch = .false.
2585 cpabort(
"invalid beta")
2588 IF (iatom <= jatom)
THEN
2589 IF (iatom == lambda) &
2591 la_max(iset), zeta(ipgf, iset), la_min(iset), &
2592 lb_max(jset), zetb(jpgf, jset), lb_min(jset), &
2593 ra, rab, scale, pab, na1 - 1, nb1 - 1, &
2594 rsgrid=rs_rho(igrid_level), &
2595 ga_gb_function=dabqadb_func, radius=radius, &
2596 use_subpatch=use_subpatch, &
2597 subpatch_pattern=tasks(itask)%subpatch_pattern)
2598 IF (jatom == lambda) &
2600 la_max(iset), zeta(ipgf, iset), la_min(iset), &
2601 lb_max(jset), zetb(jpgf, jset), lb_min(jset), &
2602 ra, rab, scale, pab, na1 - 1, nb1 - 1, &
2603 rsgrid=rs_rho(igrid_level), &
2604 ga_gb_function=dabqadb_func + 3, radius=radius, &
2605 use_subpatch=use_subpatch, &
2606 subpatch_pattern=tasks(itask)%subpatch_pattern)
2609 IF (jatom == lambda) &
2611 lb_max(jset), zetb(jpgf, jset), lb_min(jset), &
2612 la_max(iset), zeta(ipgf, iset), la_min(iset), &
2613 rb, rab_inv, scale, pab, nb1 - 1, na1 - 1, &
2614 rs_rho(igrid_level), &
2615 ga_gb_function=dabqadb_func, radius=radius, &
2616 use_subpatch=use_subpatch, &
2617 subpatch_pattern=tasks(itask)%subpatch_pattern)
2618 IF (iatom == lambda) &
2620 lb_max(jset), zetb(jpgf, jset), lb_min(jset), &
2621 la_max(iset), zeta(ipgf, iset), la_min(iset), &
2622 rb, rab_inv, scale, pab, nb1 - 1, na1 - 1, &
2623 rs_rho(igrid_level), &
2624 ga_gb_function=dabqadb_func + 3, radius=radius, &
2625 use_subpatch=use_subpatch, &
2626 subpatch_pattern=tasks(itask)%subpatch_pattern)
2634 IF (distributed_rs_grids)
THEN
2638 NULLIFY (deltap(img)%matrix)
2643 DEALLOCATE (pabt, workt)
2645 CALL timestop(handle)
2668 atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, &
2669 pw_env, required_function, basis_type)
2671 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: rho
2672 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_gspace
2673 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
2674 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
2675 TYPE(cell_type),
POINTER :: cell
2676 TYPE(dft_control_type),
POINTER :: dft_control
2677 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
2678 TYPE(pw_env_type),
POINTER :: pw_env
2679 INTEGER,
INTENT(IN) :: required_function
2680 CHARACTER(LEN=*),
INTENT(IN),
OPTIONAL :: basis_type
2682 CHARACTER(LEN=*),
PARAMETER :: routinen =
'collocate_single_gaussian'
2684 CHARACTER(LEN=default_string_length) :: my_basis_type
2685 INTEGER :: group_size, handle, i, iatom, igrid_level, ikind, ipgf, iset, maxco, maxsgf_set, &
2686 my_index, my_pos, na1, na2, natom, ncoa, nseta, offset, sgfa
2687 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: where_is_the_point
2688 INTEGER,
DIMENSION(:),
POINTER :: la_max, la_min, npgfa, nsgfa
2689 INTEGER,
DIMENSION(:, :),
POINTER :: first_sgfa
2691 REAL(kind=
dp) :: dab, eps_rho_rspace, radius, scale
2692 REAL(kind=
dp),
DIMENSION(3) :: ra
2693 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab, sphi_a, zeta
2694 TYPE(gridlevel_info_type),
POINTER :: gridlevel_info
2695 TYPE(gto_basis_set_type),
POINTER :: orb_basis_set
2696 TYPE(mp_comm_type) :: group
2697 TYPE(pw_pool_p_type),
DIMENSION(:),
POINTER :: pw_pools
2698 TYPE(pw_c1d_gs_type),
ALLOCATABLE,
DIMENSION(:) :: mgrid_gspace
2699 TYPE(pw_r3d_rs_type),
ALLOCATABLE,
DIMENSION(:) :: mgrid_rspace
2700 TYPE(realspace_grid_type),
DIMENSION(:),
POINTER :: rs_rho
2702 IF (
PRESENT(basis_type))
THEN
2703 my_basis_type = basis_type
2705 my_basis_type =
"ORB"
2708 CALL timeset(routinen, handle)
2710 NULLIFY (orb_basis_set, pab, la_max, la_min, npgfa, nsgfa, sphi_a, &
2711 zeta, first_sgfa, rs_rho, pw_pools)
2714 cpassert(
ASSOCIATED(pw_env))
2715 CALL pw_env_get(pw_env, rs_grids=rs_rho, pw_pools=pw_pools, &
2716 gridlevel_info=gridlevel_info)
2718 CALL pw_pools_create_pws(pw_pools, mgrid_gspace)
2719 CALL pw_pools_create_pws(pw_pools, mgrid_rspace)
2722 DO igrid_level = 1, gridlevel_info%ngrid_levels
2726 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
2731 maxsgf_set=maxsgf_set, &
2732 basis_type=my_basis_type)
2734 ALLOCATE (pab(maxco, 1))
2737 group = mgrid_rspace(1)%pw_grid%para%group
2738 my_pos = mgrid_rspace(1)%pw_grid%para%my_pos
2739 group_size = mgrid_rspace(1)%pw_grid%para%group_size
2740 ALLOCATE (where_is_the_point(0:group_size - 1))
2743 ikind = particle_set(iatom)%atomic_kind%kind_number
2744 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, basis_type=my_basis_type)
2746 first_sgf=first_sgfa, &
2754 ra(:) =
pbc(particle_set(iatom)%r, cell)
2759 ncoa = npgfa(iset)*
ncoset(la_max(iset))
2760 sgfa = first_sgfa(1, iset)
2764 DO i = 1, nsgfa(iset)
2765 IF (offset + i == required_function)
THEN
2774 pab(1:ncoa, 1) = sphi_a(1:ncoa, sgfa + my_index - 1)
2776 DO ipgf = 1, npgfa(iset)
2778 na1 = (ipgf - 1)*
ncoset(la_max(iset)) + 1
2779 na2 = ipgf*
ncoset(la_max(iset))
2784 IF (
map_gaussian_here(rs_rho(igrid_level), cell%h_inv, ra, offset, group_size, my_pos))
THEN
2786 lb_min=0, lb_max=0, ra=ra, rb=ra, rp=ra, &
2787 zetp=zeta(ipgf, iset), eps=eps_rho_rspace, &
2788 prefactor=1.0_dp, cutoff=1.0_dp)
2792 ra, (/0.0_dp, 0.0_dp, 0.0_dp/), &
2793 scale, pab, na1 - 1, 0, rs_rho(igrid_level), &
2801 offset = offset + nsgfa(iset)
2807 DO igrid_level = 1, gridlevel_info%ngrid_levels
2809 mgrid_rspace(igrid_level))
2812 CALL pw_zero(rho_gspace)
2813 DO igrid_level = 1, gridlevel_info%ngrid_levels
2814 CALL pw_transfer(mgrid_rspace(igrid_level), &
2815 mgrid_gspace(igrid_level))
2816 CALL pw_axpy(mgrid_gspace(igrid_level), rho_gspace)
2819 CALL pw_transfer(rho_gspace, rho)
2825 CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
2826 CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
2828 CALL timestop(handle)
2858 atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, &
2859 pw_env, basis_type, external_vector)
2861 TYPE(cp_fm_type),
INTENT(IN) :: mo_vectors
2862 INTEGER,
INTENT(IN) :: ivector
2863 TYPE(pw_r3d_rs_type),
INTENT(INOUT) :: rho
2864 TYPE(pw_c1d_gs_type),
INTENT(INOUT) :: rho_gspace
2865 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
2866 TYPE(qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
2867 TYPE(cell_type),
POINTER :: cell
2868 TYPE(dft_control_type),
POINTER :: dft_control
2869 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
2870 TYPE(pw_env_type),
POINTER :: pw_env
2871 CHARACTER(LEN=*),
INTENT(IN),
OPTIONAL :: basis_type
2872 REAL(kind=
dp),
DIMENSION(:),
OPTIONAL :: external_vector
2874 CHARACTER(LEN=*),
PARAMETER :: routinen =
'calculate_wavefunction'
2876 CHARACTER(LEN=default_string_length) :: my_basis_type
2877 INTEGER :: group_size, handle, i, iatom, igrid_level, ikind, ipgf, iset, maxco, maxsgf_set, &
2878 my_pos, na1, na2, nao, natom, ncoa, nseta, offset, sgfa
2879 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: where_is_the_point
2880 INTEGER,
DIMENSION(:),
POINTER :: la_max, la_min, npgfa, nsgfa
2881 INTEGER,
DIMENSION(:, :),
POINTER :: first_sgfa
2883 REAL(kind=
dp) :: dab, eps_rho_rspace, radius, scale
2884 REAL(kind=
dp),
DIMENSION(3) :: ra
2885 REAL(kind=
dp),
DIMENSION(:),
POINTER :: eigenvector
2886 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: pab, sphi_a, work, zeta
2887 TYPE(gridlevel_info_type),
POINTER :: gridlevel_info
2888 TYPE(gto_basis_set_type),
POINTER :: orb_basis_set
2889 TYPE(mp_comm_type) :: group
2890 TYPE(pw_pool_p_type),
DIMENSION(:),
POINTER :: pw_pools
2891 TYPE(pw_c1d_gs_type),
ALLOCATABLE,
DIMENSION(:) :: mgrid_gspace
2892 TYPE(pw_r3d_rs_type),
ALLOCATABLE,
DIMENSION(:) :: mgrid_rspace
2893 TYPE(realspace_grid_type),
DIMENSION(:),
POINTER :: rs_rho
2895 IF (
PRESENT(basis_type))
THEN
2896 my_basis_type = basis_type
2898 my_basis_type =
"ORB"
2901 CALL timeset(routinen, handle)
2903 NULLIFY (eigenvector, orb_basis_set, pab, work, la_max, la_min, &
2904 npgfa, nsgfa, sphi_a, zeta, first_sgfa, rs_rho, pw_pools)
2906 IF (
PRESENT(external_vector))
THEN
2907 nao =
SIZE(external_vector)
2908 ALLOCATE (eigenvector(nao))
2909 eigenvector = external_vector
2912 ALLOCATE (eigenvector(nao))
2919 cpassert(
ASSOCIATED(pw_env))
2920 CALL pw_env_get(pw_env, rs_grids=rs_rho, pw_pools=pw_pools, &
2921 gridlevel_info=gridlevel_info)
2923 CALL pw_pools_create_pws(pw_pools, mgrid_gspace)
2924 CALL pw_pools_create_pws(pw_pools, mgrid_rspace)
2927 DO igrid_level = 1, gridlevel_info%ngrid_levels
2931 eps_rho_rspace = dft_control%qs_control%eps_rho_rspace
2936 maxsgf_set=maxsgf_set, &
2937 basis_type=my_basis_type)
2939 ALLOCATE (pab(maxco, 1))
2940 ALLOCATE (work(maxco, 1))
2943 group = mgrid_rspace(1)%pw_grid%para%group
2944 my_pos = mgrid_rspace(1)%pw_grid%para%my_pos
2945 group_size = mgrid_rspace(1)%pw_grid%para%group_size
2946 ALLOCATE (where_is_the_point(0:group_size - 1))
2949 ikind = particle_set(iatom)%atomic_kind%kind_number
2950 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, basis_type=my_basis_type)
2952 first_sgf=first_sgfa, &
2960 ra(:) =
pbc(particle_set(iatom)%r, cell)
2965 ncoa = npgfa(iset)*
ncoset(la_max(iset))
2966 sgfa = first_sgfa(1, iset)
2968 DO i = 1, nsgfa(iset)
2969 work(i, 1) = eigenvector(offset + i)
2972 CALL dgemm(
"N",
"N", ncoa, 1, nsgfa(iset), &
2973 1.0_dp, sphi_a(1, sgfa),
SIZE(sphi_a, 1), &
2974 work(1, 1),
SIZE(work, 1), &
2975 0.0_dp, pab(1, 1),
SIZE(pab, 1))
2977 DO ipgf = 1, npgfa(iset)
2979 na1 = (ipgf - 1)*
ncoset(la_max(iset)) + 1
2980 na2 = ipgf*
ncoset(la_max(iset))
2985 IF (
map_gaussian_here(rs_rho(igrid_level), cell%h_inv, ra, offset, group_size, my_pos))
THEN
2987 lb_min=0, lb_max=0, ra=ra, rb=ra, rp=ra, &
2988 zetp=zeta(ipgf, iset), eps=eps_rho_rspace, &
2989 prefactor=1.0_dp, cutoff=1.0_dp)
2993 ra, (/0.0_dp, 0.0_dp, 0.0_dp/), &
2994 scale, pab, na1 - 1, 0, rs_rho(igrid_level), &
3000 offset = offset + nsgfa(iset)
3006 DO igrid_level = 1, gridlevel_info%ngrid_levels
3008 mgrid_rspace(igrid_level))
3011 CALL pw_zero(rho_gspace)
3012 DO igrid_level = 1, gridlevel_info%ngrid_levels
3013 CALL pw_transfer(mgrid_rspace(igrid_level), &
3014 mgrid_gspace(igrid_level))
3015 CALL pw_axpy(mgrid_gspace(igrid_level), rho_gspace)
3018 CALL pw_transfer(rho_gspace, rho)
3021 DEALLOCATE (eigenvector)
3028 CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
3029 CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
3031 CALL timestop(handle)
subroutine pbc(r, r_pbc, s, s_pbc, a, b, c, alpha, beta, gamma, debug, info, pbc0, h, hinv)
...
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
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.
Types and set/get functions for auxiliary density matrix methods.
subroutine, public get_admm_env(admm_env, mo_derivs_aux_fit, mos_aux_fit, sab_aux_fit, sab_aux_fit_asymm, sab_aux_fit_vs_orb, matrix_s_aux_fit, matrix_s_aux_fit_kp, matrix_s_aux_fit_vs_orb, matrix_s_aux_fit_vs_orb_kp, task_list_aux_fit, matrix_ks_aux_fit, matrix_ks_aux_fit_kp, matrix_ks_aux_fit_im, matrix_ks_aux_fit_dft, matrix_ks_aux_fit_hfx, matrix_ks_aux_fit_dft_kp, matrix_ks_aux_fit_hfx_kp, rho_aux_fit, rho_aux_fit_buffer, admm_dm)
Get routine for the ADMM env.
All kind of helpful little routines.
real(kind=dp) function, public exp_radius_very_extended(la_min, la_max, lb_min, lb_max, pab, o1, o2, ra, rb, rp, zetp, eps, prefactor, cutoff, epsabs)
computes the radius of the Gaussian outside of which it is smaller than eps
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
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)
...
Handles all functions related to the CELL.
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
DBCSR operations in CP2K.
represent a full matrix distributed on many processors
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
subroutine, public cp_fm_get_element(matrix, irow_global, icol_global, alpha, local)
returns an element of a fm this value is valid on every cpu using this call is expensive
Definition of the atomic potential types.
integer function, public gaussian_gridlevel(gridlevel_info, exponent)
...
Fortran API for the grid package, which is written in C.
integer, parameter, public grid_func_core_x
integer, parameter, public grid_func_dab_z
subroutine, public grid_collocate_task_list(task_list, ga_gb_function, pab_blocks, rs_grids)
Collocate all tasks of in given list onto given grids.
integer, parameter, public grid_func_dzdx
integer, parameter, public grid_func_dzdz
integer, parameter, public grid_func_dydz
integer, parameter, public grid_func_dxdy
integer, parameter, public grid_func_dabpadb_y
integer, parameter, public grid_func_dab_y
integer, parameter, public grid_func_dxdx
integer, parameter, public grid_func_dadb
integer, parameter, public grid_func_dydy
integer, parameter, public grid_func_dabpadb_z
integer, parameter, public grid_func_dabpadb_x
integer, parameter, public grid_func_dx
integer, parameter, public grid_func_dz
integer, parameter, public grid_func_ab
integer, parameter, public grid_func_core_y
integer, parameter, public grid_func_dab_x
subroutine, public collocate_pgf_product(la_max, zeta, la_min, lb_max, zetb, lb_min, ra, rab, scale, pab, o1, o2, rsgrid, ga_gb_function, radius, use_subpatch, subpatch_pattern)
low level collocation of primitive gaussian functions
integer, parameter, public grid_func_core_z
integer, parameter, public grid_func_dy
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
contains the types and subroutines for dealing with the lri_env lri : local resolution of the identit...
Utility routines for the memory handling.
Interface to the message passing library MPI.
Provides Cartesian and spherical orbital pointers and indices.
integer, dimension(:), allocatable, public ncoset
integer, dimension(:, :, :), allocatable, public coset
Define the data structure for the particle information.
container for various plainwaves related things
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
subroutine, public calculate_drho_elec_dr(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, soft_valid, basis_type, beta, lambda)
Computes the gradient wrt. nuclear coordinates of a density on the grid The density is given in terms...
subroutine, public calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, soft_valid, basis_type)
computes the gradient of the density corresponding to a given density matrix on the grid
subroutine, public calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ks_env, soft_valid, compute_tau, compute_grad, basis_type, der_type, idir, task_list_external, pw_env_external)
computes the density corresponding to a given density matrix on the grid
subroutine, public calculate_rho_metal(rho_metal, coeff, total_rho_metal, qs_env)
computes the image charge density on the grid (including coeffcients)
subroutine, public calculate_rho_resp_single(rho_gb, qs_env, eta, iatom_in)
collocate a single Gaussian on the grid for periodic RESP fitting
subroutine, public calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, pw_env, basis_type, external_vector)
maps a given wavefunction on the grid
subroutine, public calculate_rho_nlcc(rho_nlcc, qs_env)
computes the density of the non-linear core correction on the grid
subroutine, public calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, lri_coef, total_rho, basis_type, exact_1c_terms, pmat, atomlist)
Collocates the fitted lri density on a grid.
subroutine, public collocate_single_gaussian(rho, rho_gspace, atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, pw_env, required_function, basis_type)
maps a single gaussian on the grid
subroutine, public calculate_rho_single_gaussian(rho_gb, qs_env, iatom_in)
collocate a single Gaussian on the grid
subroutine, public calculate_ppl_grid(vppl, qs_env)
computes the local pseudopotential (without erf term) on the grid
subroutine, public calculate_drho_core(drho_core, qs_env, beta, lambda)
Computes the derivative of the density of the core charges with respect to the nuclear coordinates on...
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_RI_aux_kp, matrix_s, matrix_s_RI_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, ecoul_1c, rho0_s_rs, rho0_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, WannierCentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, rhs)
Get the QUICKSTEP environment.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, 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_r3d_rs_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, floating, name, element_symbol, pao_basis_size, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
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)
Get attributes of an atomic kind set.
subroutine, public get_ks_env(ks_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, complex_ks, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, kinetic, matrix_s, matrix_s_RI_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_RI_aux_kp, matrix_ks_im_kp, rho, rho_xc, vppl, rho_core, rho_nlcc, rho_nlcc_g, vee, neighbor_list_id, sab_orb, sab_all, sac_ae, sac_ppl, sac_lri, sap_ppnl, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_nonbond, sab_vdw, sab_scp, sab_almo, sab_kp, sab_kp_nosym, task_list, task_list_soft, kpoints, do_kpoints, atomic_kind_set, qs_kind_set, cell, cell_ref, use_ref_cell, particle_set, energy, force, local_particles, local_molecules, molecule_kind_set, molecule_set, subsys, cp_subsys, virial, results, atprop, nkind, natom, dft_control, dbcsr_dist, distribution_2d, pw_env, para_env, blacs_env, nelectron_total, nelectron_spin)
...
Define the neighbor list data types and the corresponding functionality.
pure logical function, public map_gaussian_here(rs_grid, h_inv, ra, offset, group_size, my_pos)
...
subroutine, public transfer_rs2pw(rs, pw)
...
subroutine, public rs_grid_zero(rs)
Initialize grid to zero.
Transfers densities from PW to RS grids and potentials from PW to RS.
subroutine, public density_rs2pw(pw_env, rs_rho, rho, rho_gspace)
given partial densities on the realspace multigrids, computes the full density on the plane wave grid...
generate the tasks lists used by collocate and integrate routines
subroutine, public rs_scatter_matrices(src_matrices, dest_buffer, task_list, group)
Scatters dbcsr matrix blocks and receives them into a buffer as needed before collocation.
subroutine, public rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, nimages, scatter, hmats)
redistributes the matrix so that it can be used in realspace operations i.e. according to the task li...
subroutine, public rs_copy_to_buffer(src_matrices, dest_buffer, task_list)
Copies the DBCSR blocks into buffer, replaces rs_scatter_matrix for non-distributed grids.