18 USE dbcsr_api,
ONLY: dbcsr_add,&
19 dbcsr_add_block_node,&
32 neighbor_list_iterator_p_type,&
34 neighbor_list_set_p_type
43 #include "./base/base_uses.f90"
49 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'lri_ks_methods'
66 TYPE(lri_environment_type),
POINTER :: lri_env
67 TYPE(lri_kind_type),
DIMENSION(:),
POINTER :: lri_v_int
68 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: h_matrix
69 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
70 INTEGER,
DIMENSION(:, :, :),
OPTIONAL,
POINTER :: cell_to_index
72 CHARACTER(*),
PARAMETER :: routinen =
'calculate_lri_ks_matrix'
74 INTEGER :: atom_a, atom_b, col, handle, i, iac, iatom, ic, ikind, ilist, jatom, jkind, &
75 jneighbor, mepos, nba, nbb, nfa, nfb, nkind, nlist, nm, nn, nthread, row
76 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: atom_of_kind
77 INTEGER,
DIMENSION(3) :: cell
78 LOGICAL :: found, trans, use_cell_mapping
79 REAL(kind=
dp) :: dab, fw, isn, isna, isnb, rab(3), &
81 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: vi, via, vib
82 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: hf_work, hs_work, int3, wab, wbb
83 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: h_block
84 TYPE(dbcsr_type),
POINTER :: hmat
85 TYPE(lri_int_type),
POINTER :: lrii
86 TYPE(neighbor_list_iterator_p_type), &
87 DIMENSION(:),
POINTER :: nl_iterator
88 TYPE(neighbor_list_set_p_type),
DIMENSION(:), &
91 CALL timeset(routinen, handle)
92 NULLIFY (h_block, lrii, nl_iterator, soo_list)
94 threshold = lri_env%eps_o3_int
96 use_cell_mapping = (
SIZE(h_matrix, 1) > 1)
97 IF (use_cell_mapping)
THEN
98 cpassert(
PRESENT(cell_to_index))
101 IF (
ASSOCIATED(lri_env%soo_list))
THEN
102 soo_list => lri_env%soo_list
104 nkind = lri_env%lri_ints%nkind
121 CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=jkind, iatom=iatom, &
122 jatom=jatom, nlist=nlist, ilist=ilist, inode=jneighbor, &
125 iac = ikind + nkind*(jkind - 1)
126 dab = sqrt(sum(rab*rab))
128 IF (.NOT.
ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) cycle
129 IF (lri_env%exact_1c_terms)
THEN
130 IF (iatom == jatom .AND. dab < lri_env%delta) cycle
133 lrii => lri_env%lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int(jneighbor)
141 atom_a = atom_of_kind(iatom)
142 atom_b = atom_of_kind(jatom)
144 IF (use_cell_mapping)
THEN
145 ic = cell_to_index(cell(1), cell(2), cell(3))
150 hmat => h_matrix(ic)%matrix
152 ALLOCATE (int3(nba, nbb))
154 ALLOCATE (hs_work(nba, nbb))
155 IF (iatom == jatom .AND. dab < lri_env%delta)
THEN
158 vi(1:nfa) = lri_v_int(ikind)%v_int(atom_a, 1:nfa)
162 vi(1:nfa) = lri_v_int(ikind)%v_int(atom_a, 1:nfa)
163 vi(nfa + 1:nn) = lri_v_int(jkind)%v_int(atom_b, 1:nfb)
165 isn = sum(lrii%sn(1:nm)*vi(1:nm))/lrii%nsn
166 vi(1:nm) = matmul(lrii%sinv(1:nm, 1:nm), vi(1:nm)) - isn*lrii%sn(1:nm)
167 hs_work(1:nba, 1:nbb) = isn*lrii%soo(1:nba, 1:nbb)
168 IF (iatom == jatom .AND. dab < lri_env%delta)
THEN
171 hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb) + vi(i)*int3(1:nba, 1:nbb)
176 hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb) + vi(i)*int3(1:nba, 1:nbb)
180 hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb) + vi(nfa + i)*int3(1:nba, 1:nbb)
187 ALLOCATE (hf_work(nba, nbb), wab(nba, nbb), wbb(nba, nbb))
188 wab(1:nba, 1:nbb) = lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb)
189 wbb(1:nba, 1:nbb) = 1.0_dp - lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb)
191 ALLOCATE (via(nfa), vib(nfb))
192 via(1:nfa) = lri_v_int(ikind)%v_int(atom_a, 1:nfa)
193 vib(1:nfb) = lri_v_int(jkind)%v_int(atom_b, 1:nfb)
195 isna = sum(lrii%sna(1:nfa)*via(1:nfa))/lrii%nsna
196 isnb = sum(lrii%snb(1:nfb)*vib(1:nfb))/lrii%nsnb
197 via(1:nfa) = matmul(lrii%asinv(1:nfa, 1:nfa), via(1:nfa)) - isna*lrii%sna(1:nfa)
198 vib(1:nfb) = matmul(lrii%bsinv(1:nfb, 1:nfb), vib(1:nfb)) - isnb*lrii%snb(1:nfb)
200 hf_work(1:nba, 1:nbb) = (isna*wab(1:nba, 1:nbb) + isnb*wbb(1:nba, 1:nbb))*lrii%soo(1:nba, 1:nbb)
203 IF (lrii%abascr(i) > threshold)
THEN
205 hf_work(1:nba, 1:nbb) = hf_work(1:nba, 1:nbb) + &
206 via(i)*int3(1:nba, 1:nbb)*wab(1:nba, 1:nbb)
210 IF (lrii%abbscr(i) > threshold)
THEN
212 hf_work(1:nba, 1:nbb) = hf_work(1:nba, 1:nbb) + &
213 vib(i)*int3(1:nba, 1:nbb)*wbb(1:nba, 1:nbb)
217 DEALLOCATE (via, vib, wab, wbb)
222 IF (iatom <= jatom)
THEN
233 CALL dbcsr_get_block_p(hmat, row, col, h_block, found)
234 IF (.NOT.
ASSOCIATED(h_block))
THEN
235 CALL dbcsr_add_block_node(hmat, row, col, h_block)
240 h_block(1:nbb, 1:nba) = h_block(1:nbb, 1:nba) + fw*transpose(hs_work(1:nba, 1:nbb))
242 h_block(1:nba, 1:nbb) = h_block(1:nba, 1:nbb) + fw*hs_work(1:nba, 1:nbb)
248 h_block(1:nbb, 1:nba) = h_block(1:nbb, 1:nba) + fw*transpose(hf_work(1:nba, 1:nbb))
250 h_block(1:nba, 1:nbb) = h_block(1:nba, 1:nbb) + fw*hf_work(1:nba, 1:nbb)
255 IF (lrii%lrisr)
DEALLOCATE (hs_work)
256 IF (lrii%lriff)
DEALLOCATE (hf_work)
260 DO ic = 1,
SIZE(h_matrix, 1)
261 CALL dbcsr_finalize(h_matrix(ic)%matrix)
268 CALL timestop(handle)
283 atomic_kind_set, ispin)
285 TYPE(lri_environment_type),
POINTER :: lri_env
286 TYPE(lri_kind_type),
DIMENSION(:),
POINTER :: lri_v_int
287 TYPE(dbcsr_type),
POINTER :: h_matrix, s_matrix
288 TYPE(atomic_kind_type),
DIMENSION(:),
POINTER :: atomic_kind_set
289 INTEGER,
INTENT(IN) :: ispin
291 CHARACTER(*),
PARAMETER :: routinen =
'calculate_ri_ks_matrix'
293 INTEGER :: atom_a, handle, i1, i2, iatom, ikind, n, &
295 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: atom_of_kind, kind_of, nsize
296 INTEGER,
DIMENSION(:, :),
POINTER :: bas_ptr
297 REAL(kind=
dp) :: fscal, ftrm1n
298 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: fout, fvec
299 REAL(kind=
dp),
DIMENSION(:),
POINTER :: v
300 TYPE(o3c_vec_type),
DIMENSION(:),
POINTER :: o3c_vec
302 CALL timeset(routinen, handle)
304 bas_ptr => lri_env%ri_fit%bas_ptr
305 natom =
SIZE(bas_ptr, 2)
306 nbas = bas_ptr(2, natom)
307 ALLOCATE (fvec(nbas), fout(nbas))
310 ikind = kind_of(iatom)
311 atom_a = atom_of_kind(iatom)
312 i1 = bas_ptr(1, iatom)
313 i2 = bas_ptr(2, iatom)
315 fvec(i1:i2) = lri_v_int(ikind)%v_int(atom_a, 1:n)
318 ftrm1n = sum(fvec(:)*lri_env%ri_fit%rm1n(:))
319 lri_env%ri_fit%ftrm1n(ispin) = ftrm1n
320 fscal = ftrm1n/lri_env%ri_fit%ntrm1n
322 fvec(:) = fvec(:) - fscal*lri_env%ri_fit%nvec(:)
327 matp=lri_env%ri_sinv(1)%matrix, &
328 solver=lri_env%ri_sinv_app, &
330 lri_env%ri_fit%fout(:, ispin) = fout(:)
333 CALL dbcsr_add(h_matrix, s_matrix, 1.0_dp, fscal)
336 ALLOCATE (nsize(natom), o3c_vec(natom))
338 i1 = bas_ptr(1, iatom)
339 i2 = bas_ptr(2, iatom)
346 i1 = bas_ptr(1, iatom)
347 i2 = bas_ptr(2, iatom)
356 DEALLOCATE (o3c_vec, fvec, fout)
358 CALL timestop(handle)
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.
Defines the basic variable types.
integer, parameter, public dp
integral compression (fix point accuracy)
subroutine, public lri_decomp_i(aval, cont, ival)
...
contains the types and subroutines for dealing with the lri_env lri : local resolution of the identit...
routines that build the Kohn-Sham matrix for the LRIGPW and xc parts
subroutine, public calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set, cell_to_index)
update of LRIGPW KS matrix
subroutine, public calculate_ri_ks_matrix(lri_env, lri_v_int, h_matrix, s_matrix, atomic_kind_set, ispin)
update of RIGPW KS matrix
Define the neighbor list data types and the corresponding functionality.
subroutine, public neighbor_list_iterator_create(iterator_set, nl, search, nthread)
Neighbor list iterator functions.
subroutine, public neighbor_list_iterator_release(iterator_set)
...
integer function, public neighbor_list_iterate(iterator_set, mepos)
...
subroutine, public get_iterator_info(iterator_set, mepos, ikind, jkind, nkind, ilist, nlist, inode, nnode, iatom, jatom, r, cell)
...
Methods used with 3-center overlap type integrals containers.
subroutine, public contract3_o3c(o3c, vec, matrix)
Contraction of 3-tensor over index 3 h(ij) = h(ij) + sum_k (ijk)*v(k)
3-center overlap type integrals containers
subroutine, public o3c_vec_create(o3c_vec, nsize)
...
subroutine, public get_o3c_vec(o3c_vec, i, vec, n)
...
subroutine, public o3c_vec_release(o3c_vec)
...
Calculates integral matrices for RIGPW method.
subroutine, public ri_metric_solver(mat, vecr, vecx, matp, solver, ptr)
solver for RI systems (R*x=n)