mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-31 08:33:40 +02:00
cleaning
This commit is contained in:
parent
8176291618
commit
d05c851ba6
@ -318,6 +318,7 @@ double precision function get_mo_bielec_integral_schwartz(i,j,k,l,map)
|
|||||||
get_mo_bielec_integral_schwartz = dble(tmp)
|
get_mo_bielec_integral_schwartz = dble(tmp)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
double precision function mo_bielec_integral(i,j,k,l)
|
double precision function mo_bielec_integral(i,j,k,l)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -356,36 +357,37 @@ subroutine get_mo_bielec_integrals(j,k,l,sze,out_val,map)
|
|||||||
call map_get_many(map, hash, tmp_val, sze)
|
call map_get_many(map, hash, tmp_val, sze)
|
||||||
! Conversion to double precision
|
! Conversion to double precision
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
out_val(i) = tmp_val(i)
|
out_val(i) = dble(tmp_val(i))
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine get_mo_bielec_integrals_existing_ik(j,l,sze,out_array,map)
|
subroutine get_mo_bielec_integrals_ij(k,l,sze,out_array,map)
|
||||||
use map_module
|
use map_module
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Returns multiple integrals <ij|kl> in the MO basis, all
|
! Returns multiple integrals <ij|kl> in the MO basis, all
|
||||||
! i(1)j(1) 1/r12 k(2)l(2)
|
! i(1)j(2) 1/r12 k(1)l(2)
|
||||||
! i for j,k,l fixed.
|
! i, j for k,l fixed.
|
||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: j,l, sze
|
integer, intent(in) :: k,l, sze
|
||||||
logical, intent(out) :: out_array(sze,sze)
|
logical, intent(out) :: out_array(sze,sze)
|
||||||
type(map_type), intent(inout) :: map
|
type(map_type), intent(inout) :: map
|
||||||
integer :: i,k,kk,ll,m
|
integer :: i,j,kk,ll,m
|
||||||
integer(key_kind),allocatable :: hash(:)
|
integer(key_kind),allocatable :: hash(:)
|
||||||
integer ,allocatable :: pairs(:,:), iorder(:)
|
integer ,allocatable :: pairs(:,:), iorder(:)
|
||||||
PROVIDE mo_bielec_integrals_in_map
|
PROVIDE mo_bielec_integrals_in_map
|
||||||
allocate (hash(sze*sze), pairs(2,sze*sze),iorder(sze*sze))
|
allocate (hash(sze*sze), pairs(2,sze*sze),iorder(sze*sze))
|
||||||
|
|
||||||
kk=0
|
kk=0
|
||||||
do k=1,sze
|
out_array = 0.d0
|
||||||
|
do j=1,sze
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
kk += 1
|
kk += 1
|
||||||
!DIR$ FORCEINLINE
|
!DIR$ FORCEINLINE
|
||||||
call bielec_integrals_index(i,j,k,l,hash(kk))
|
call bielec_integrals_index(i,j,k,l,hash(kk))
|
||||||
pairs(1,kk) = i
|
pairs(1,kk) = i
|
||||||
pairs(2,kk) = k
|
pairs(2,kk) = j
|
||||||
iorder(kk) = kk
|
iorder(kk) = kk
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -404,8 +406,8 @@ subroutine get_mo_bielec_integrals_existing_ik(j,l,sze,out_array,map)
|
|||||||
do ll=1,kk
|
do ll=1,kk
|
||||||
m = iorder(ll)
|
m = iorder(ll)
|
||||||
i=pairs(1,m)
|
i=pairs(1,m)
|
||||||
k=pairs(2,m)
|
j=pairs(2,m)
|
||||||
out_array(i,k) = (hash(ll) /= 0_8)
|
out_array(i,j) = (hash(ll) /= 0_8)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
deallocate(pairs,hash,iorder)
|
deallocate(pairs,hash,iorder)
|
||||||
|
@ -102,7 +102,7 @@ subroutine add_integrals_to_map(mask_ijkl)
|
|||||||
!$OMP mo_coef_transp, &
|
!$OMP mo_coef_transp, &
|
||||||
!$OMP mo_coef_transp_is_built, list_ijkl, &
|
!$OMP mo_coef_transp_is_built, list_ijkl, &
|
||||||
!$OMP mo_coef_is_built, wall_1, abort_here, &
|
!$OMP mo_coef_is_built, wall_1, abort_here, &
|
||||||
!$OMP mo_coef,mo_integrals_threshold,ao_integrals_map,mo_integrals_map,progress_bar,progress_value)
|
!$OMP mo_coef,mo_integrals_threshold,mo_integrals_map,progress_bar,progress_value)
|
||||||
n_integrals = 0
|
n_integrals = 0
|
||||||
allocate(bielec_tmp_3(mo_tot_num_align, n_j, n_k), &
|
allocate(bielec_tmp_3(mo_tot_num_align, n_j, n_k), &
|
||||||
bielec_tmp_1(mo_tot_num_align), &
|
bielec_tmp_1(mo_tot_num_align), &
|
||||||
@ -315,7 +315,6 @@ IRP_ENDIF
|
|||||||
call ezfio_set_integrals_bielec_disk_access_mo_integrals("Read")
|
call ezfio_set_integrals_bielec_disk_access_mo_integrals("Read")
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -437,97 +437,6 @@ call omp_unset_lock(map%lock)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine map_update_verbose(map, key, value, sze, thr)
|
|
||||||
use map_module
|
|
||||||
implicit none
|
|
||||||
type (map_type), intent(inout) :: map
|
|
||||||
integer, intent(in) :: sze
|
|
||||||
integer(key_kind), intent(inout) :: key(sze)
|
|
||||||
real(integral_kind), intent(inout) :: value(sze)
|
|
||||||
real(integral_kind), intent(in) :: thr
|
|
||||||
|
|
||||||
integer :: i
|
|
||||||
integer(map_size_kind) :: idx_cache, idx_cache_new
|
|
||||||
integer(cache_map_size_kind) :: idx
|
|
||||||
integer :: sze2
|
|
||||||
integer(cache_key_kind) :: cache_key
|
|
||||||
integer(map_size_kind) :: n_elements_temp
|
|
||||||
type (cache_map_type) :: local_map
|
|
||||||
logical :: map_sorted
|
|
||||||
! do i = 1, sze
|
|
||||||
! print*,'value in map = ',value(i)
|
|
||||||
! enddo
|
|
||||||
|
|
||||||
sze2 = sze
|
|
||||||
map_sorted = .True.
|
|
||||||
|
|
||||||
n_elements_temp = 0_8
|
|
||||||
n_elements_temp = n_elements_temp + 1_8
|
|
||||||
do while (sze2>0)
|
|
||||||
i=1
|
|
||||||
do while (i<=sze)
|
|
||||||
if (key(i) /= 0_8) then
|
|
||||||
idx_cache = ishft(key(i),map_shift)
|
|
||||||
if (omp_test_lock(map%map(idx_cache)%lock)) then
|
|
||||||
local_map%key => map%map(idx_cache)%key
|
|
||||||
local_map%value => map%map(idx_cache)%value
|
|
||||||
local_map%sorted = map%map(idx_cache)%sorted
|
|
||||||
local_map%map_size = map%map(idx_cache)%map_size
|
|
||||||
local_map%n_elements = map%map(idx_cache)%n_elements
|
|
||||||
do
|
|
||||||
!DIR$ FORCEINLINE
|
|
||||||
call search_key_big_interval(key(i),local_map%key, local_map%n_elements, idx, 1, local_map%n_elements)
|
|
||||||
if (idx > 0_8) then
|
|
||||||
! print*,'AHAAH'
|
|
||||||
! print*,'local_map%value(idx) = ',local_map%value(idx)
|
|
||||||
local_map%value(idx) = local_map%value(idx) + value(i)
|
|
||||||
! print*,'not a new value !'
|
|
||||||
! print*,'local_map%value(idx) = ',local_map%value(idx)
|
|
||||||
else
|
|
||||||
! Assert that the map has a proper size
|
|
||||||
if (local_map%n_elements == local_map%map_size) then
|
|
||||||
call cache_map_unique(local_map)
|
|
||||||
call cache_map_reallocate(local_map, local_map%n_elements + local_map%n_elements)
|
|
||||||
call cache_map_shrink(local_map,thr)
|
|
||||||
endif
|
|
||||||
cache_key = iand(key(i),map_mask)
|
|
||||||
local_map%n_elements = local_map%n_elements + 1_8
|
|
||||||
local_map%value(local_map%n_elements) = value(i)
|
|
||||||
! print*,'new value !'
|
|
||||||
local_map%key(local_map%n_elements) = cache_key
|
|
||||||
local_map%sorted = .False.
|
|
||||||
n_elements_temp = n_elements_temp + 1_8
|
|
||||||
endif ! idx > 0
|
|
||||||
key(i) = 0_8
|
|
||||||
i = i+1
|
|
||||||
sze2 = sze2-1
|
|
||||||
if (i>sze) then
|
|
||||||
i=1
|
|
||||||
endif
|
|
||||||
if ( (ishft(key(i),map_shift) /= idx_cache).or.(key(i)==0_8)) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
map%map(idx_cache)%key => local_map%key
|
|
||||||
map%map(idx_cache)%value => local_map%value
|
|
||||||
map%map(idx_cache)%sorted = local_map%sorted
|
|
||||||
map%map(idx_cache)%n_elements = local_map%n_elements
|
|
||||||
map%map(idx_cache)%map_size = local_map%map_size
|
|
||||||
map_sorted = map_sorted .and. local_map%sorted
|
|
||||||
call omp_unset_lock(map%map(idx_cache)%lock)
|
|
||||||
endif ! omp_test_lock
|
|
||||||
else
|
|
||||||
i=i+1
|
|
||||||
endif ! key = 0
|
|
||||||
enddo ! i
|
|
||||||
enddo ! sze2 > 0
|
|
||||||
call omp_set_lock(map%lock)
|
|
||||||
map%n_elements = map%n_elements + n_elements_temp
|
|
||||||
map%sorted = map%sorted .and. map_sorted
|
|
||||||
call omp_unset_lock(map%lock)
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine map_append(map, key, value, sze)
|
subroutine map_append(map, key, value, sze)
|
||||||
use map_module
|
use map_module
|
||||||
implicit none
|
implicit none
|
||||||
|
Loading…
Reference in New Issue
Block a user