LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-19 19:52:15 +02:00
Code Issues Releases Wiki Activity

cleaning

Browse Source
This commit is contained in:
Anthony Scemama 2015-11-25 01:08:31 +01:00
parent 8176291618
commit d05c851ba6
3 changed files with 13 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/Integrals_Bielec/map_integrals.irp.f
View File

@ -318,6 +318,7 @@ double precision function get_mo_bielec_integral_schwartz(i,j,k,l,map)
get_mo_bielec_integral_schwartz = dble(tmp)
end
double precision function mo_bielec_integral(i,j,k,l)
implicit none
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)
! Conversion to double precision
do i=1,sze
out_val(i) = tmp_val(i)
out_val(i) = dble(tmp_val(i))
enddo
endif
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
implicit none
BEGIN_DOC
! Returns multiple integrals <ij|kl> in the MO basis, all
! i(1)j(1) 1/r12 k(2)l(2)
! i for j,k,l fixed.
! i(1)j(2) 1/r12 k(1)l(2)
! i, j for k,l fixed.
END_DOC
integer, intent(in) :: j,l, sze
integer, intent(in) :: k,l, sze
logical, intent(out) :: out_array(sze,sze)
type(map_type), intent(inout) :: map
integer :: i,k,kk,ll,m
integer :: i,j,kk,ll,m
integer(key_kind),allocatable :: hash(:)
integer ,allocatable :: pairs(:,:), iorder(:)
PROVIDE mo_bielec_integrals_in_map
allocate (hash(sze*sze), pairs(2,sze*sze),iorder(sze*sze))
kk=0
do k=1,sze
out_array = 0.d0
do j=1,sze
do i=1,sze
kk += 1
!DIR$ FORCEINLINE
call bielec_integrals_index(i,j,k,l,hash(kk))
pairs(1,kk) = i
pairs(2,kk) = k
pairs(2,kk) = j
iorder(kk) = kk
enddo
enddo
@ -404,8 +406,8 @@ subroutine get_mo_bielec_integrals_existing_ik(j,l,sze,out_array,map)
do ll=1,kk
m = iorder(ll)
i=pairs(1,m)
k=pairs(2,m)
out_array(i,k) = (hash(ll) /= 0_8)
j=pairs(2,m)
out_array(i,j) = (hash(ll) /= 0_8)
enddo
deallocate(pairs,hash,iorder)

3
src/Integrals_Bielec/mo_bi_integrals.irp.f
View File

@ -102,7 +102,7 @@ subroutine add_integrals_to_map(mask_ijkl)
!$OMP mo_coef_transp, &
!$OMP mo_coef_transp_is_built, list_ijkl, &
!$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
allocate(bielec_tmp_3(mo_tot_num_align, n_j, n_k), &
bielec_tmp_1(mo_tot_num_align), &
@ -315,7 +315,6 @@ IRP_ENDIF
call ezfio_set_integrals_bielec_disk_access_mo_integrals("Read")
endif
end

91
src/Utils/map_module.f90
View File

@ -437,97 +437,6 @@ call omp_unset_lock(map%lock)
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)
use map_module
implicit none