LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 12:56:14 +01:00
Code Issues Releases Wiki Activity

corrected parallelism bug

Browse Source
This commit is contained in:
Yann Garniron 2015-11-02 20:56:02 +01:00
parent 67836776e1
commit 4eed037ecf
3 changed files with 123 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
plugins/MRCC_Utils/davidson.irp.f
View File

@ -495,6 +495,8 @@ subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate)
integer :: shortcut(0:n+1), sort_idx(n) integer :: shortcut(0:n+1), sort_idx(n)
integer(bit_kind) :: sorted(Nint,n), version(Nint,n) integer(bit_kind) :: sorted(Nint,n), version(Nint,n)
integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, pass integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, pass
! !
@ -520,24 +522,15 @@ subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate)
allocate(idx(0:n), vt(n)) allocate(idx(0:n), vt(n))
Vt = 0.d0 Vt = 0.d0
do pass=1,2
if(pass == 1) then !$OMP SINGLE
call sort_dets_ab_v(keys_tmp, sorted, sort_idx, shortcut, version, n, Nint) call sort_dets_ab_v(keys_tmp, sorted, sort_idx, shortcut, version, n, Nint)
else !$OMP END SINGLE
call sort_dets_ba_v(keys_tmp, sorted, sort_idx, shortcut, version, n, Nint)
end if
!$OMP DO SCHEDULE(dynamic) !$OMP DO SCHEDULE(dynamic)
do sh=1,shortcut(0) do sh=1,shortcut(0)
do sh2=1,sh
if(pass == 2) then
endi = sh
else
endi = 1
end if
do sh2=endi,sh
exa = 0 exa = 0
do ni=1,Nint do ni=1,Nint
exa += popcnt(xor(version(ni,sh), version(ni,sh2))) exa += popcnt(xor(version(ni,sh), version(ni,sh2)))
@ -561,20 +554,40 @@ subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate)
if(ext <= 4) then if(ext <= 4) then
org_i = sort_idx(i) org_i = sort_idx(i)
org_j = sort_idx(j) org_j = sort_idx(j)
if ( (dabs(u_0(org_j)) > 1.d-7).or.((dabs(u_0(org_i)) > 1.d-7)) ) then
call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij)
vt (org_i) = vt (org_i) + hij*u_0(org_j) vt (org_i) = vt (org_i) + hij*u_0(org_j)
vt (org_j) = vt (org_j) + hij*u_0(org_i) vt (org_j) = vt (org_j) + hij*u_0(org_i)
endif
end if end if
end do end do
end do end do
end do end do
enddo enddo
!$OMP END DO !$OMP END DO
!$OMP SINGLE
call sort_dets_ba_v(keys_tmp, sorted, sort_idx, shortcut, version, n, Nint)
!$OMP END SINGLE
!$OMP DO SCHEDULE(dynamic)
do sh=1,shortcut(0)
do i=shortcut(sh),shortcut(sh+1)-1
do j=shortcut(sh),i-1
ext = 0
do ni=1,Nint
ext += popcnt(xor(sorted(ni,i), sorted(ni,j)))
end do end do
if(ext <= 4) then
org_i = sort_idx(i)
org_j = sort_idx(j)
call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij)
vt (org_i) = vt (org_i) + hij*u_0(org_j)
vt (org_j) = vt (org_j) + hij*u_0(org_i)
end if
end do
end do
enddo
!$OMP END DO
!$OMP DO SCHEDULE(guided) !$OMP DO SCHEDULE(guided)

1
src/Determinants/davidson.irp.f
View File

@ -178,6 +178,7 @@ subroutine sort_dets_ab_v(key_in, key_out, idx, shortcut, version, N_key, Nint)
shortcut(0) = 1 shortcut(0) = 1
shortcut(1) = 1 shortcut(1) = 1
version(:,1) = key(:,1,1)
do i=2,N_key do i=2,N_key
do ni=1,nint do ni=1,nint
if(key(ni,1,i) /= key(ni,1,i-1)) then if(key(ni,1,i) /= key(ni,1,i-1)) then

46
src/Determinants/s2.irp.f
View File

@ -132,24 +132,15 @@ subroutine get_s2_u0(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2)
!$OMP REDUCTION(+:s2) !$OMP REDUCTION(+:s2)
allocate(idx(0:n)) allocate(idx(0:n))
do pass=1,2
if(pass == 1) then
call sort_dets_ab_v(psi_keys_tmp, sorted, sort_idx, shortcut, version, n, N_int)
else
call sort_dets_ba_v(psi_keys_tmp, sorted, sort_idx, shortcut, version, n, N_int)
end if
!$OMP SINGLE
call sort_dets_ab_v(psi_keys_tmp, sorted, sort_idx, shortcut, version, n, N_int)
!$OMP END SINGLE
!$OMP DO SCHEDULE(dynamic) !$OMP DO SCHEDULE(dynamic)
do sh=1,shortcut(0) do sh=1,shortcut(0)
if(pass == 2) then do sh2=1,sh
endi = sh
else
endi = 1
end if
do sh2=endi,sh
exa = 0 exa = 0
do ni=1,N_int do ni=1,N_int
exa += popcnt(xor(version(ni,sh), version(ni,sh2))) exa += popcnt(xor(version(ni,sh), version(ni,sh2)))
@ -174,20 +165,45 @@ subroutine get_s2_u0(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2)
org_i = sort_idx(i) org_i = sort_idx(i)
org_j = sort_idx(j) org_j = sort_idx(j)
if ( dabs(psi_coefs_tmp(org_j)) + dabs(psi_coefs_tmp(org_i)) & if ( dabs(psi_coefs_tmp(org_j)) + dabs(psi_coefs_tmp(org_i)) &
> davidson_threshold ) then > davidson_threshold ) then
call get_s2(psi_keys_tmp(1,1,org_i),psi_keys_tmp(1,1,org_j),s2_tmp,N_int) call get_s2(psi_keys_tmp(1,1,org_i),psi_keys_tmp(1,1,org_j),s2_tmp,N_int)
s2 = s2 + psi_coefs_tmp(org_i)*psi_coefs_tmp(org_j)*s2_tmp s2 = s2 + psi_coefs_tmp(org_i)*psi_coefs_tmp(org_j)*s2_tmp
endif endif
end if end if
end do end do
end do end do
end do end do
enddo enddo
!$OMP END DO !$OMP END DO
!$OMP SINGLE
call sort_dets_ba_v(psi_keys_tmp, sorted, sort_idx, shortcut, version, n, N_int)
!$OMP END SINGLE
!$OMP DO SCHEDULE(dynamic)
do sh=1,shortcut(0)
do i=shortcut(sh),shortcut(sh+1)-1
do j=shortcut(sh),i-1
ext = 0
do ni=1,N_int
ext += popcnt(xor(sorted(ni,i), sorted(ni,j)))
end do end do
if(ext <= 4) then
org_i = sort_idx(i)
org_j = sort_idx(j)
if ( dabs(psi_coefs_tmp(org_j)) + dabs(psi_coefs_tmp(org_i)) &
> davidson_threshold ) then
call get_s2(psi_keys_tmp(1,1,org_i),psi_keys_tmp(1,1,org_j),s2_tmp,N_int)
s2 = s2 + psi_coefs_tmp(org_i)*psi_coefs_tmp(org_j)*s2_tmp
endif
end if
end do
end do
enddo
!$OMP END DO
deallocate(idx) deallocate(idx)
!$OMP END PARALLEL !$OMP END PARALLEL
s2 = s2+s2 s2 = s2+s2