LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-05 11:00:10 +01:00
Code Issues Releases Wiki Activity

work on pt2 stoch

Browse Source
This commit is contained in:
Anthony Scemama 2017-01-30 20:15:28 +01:00
parent 097083db47
commit 67fded7d18
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

@ -192,6 +192,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
pt2_detail(:, index(i)) += pt2_mwen(:,i) pt2_detail(:, index(i)) += pt2_mwen(:,i)
parts_to_get(index(i)) -= 1 parts_to_get(index(i)) -= 1
if(parts_to_get(index(i)) < 0) then if(parts_to_get(index(i)) < 0) then
print *, "PARTS ??"
stop "PARTS ??" stop "PARTS ??"
end if end if
if(parts_to_get(index(i)) == 0) actually_computed(index(i)) = .true. if(parts_to_get(index(i)) == 0) actually_computed(index(i)) = .true.
@ -206,7 +207,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
time = omp_get_wtime() time = omp_get_wtime()
if(time - timeLast > 30.0 .or. more /= 1) then if(time - timeLast > 10.0 .or. more /= 1) then
timeLast = time timeLast = time
do i=1, first_det_of_teeth(1)-1 do i=1, first_det_of_teeth(1)-1
if(not(actually_computed(i))) then if(not(actually_computed(i))) then
@ -258,7 +259,7 @@ integer function pt2_find(v, w)
h = N_det-1 h = N_det-1
do while(h >= l) do while(h >= l)
i = (h+l)/2 i = ishft(h+l,-1)
if(w(i+1) > v) then if(w(i+1) > v) then
h = i-1 h = i-1
else else
@ -374,7 +375,7 @@ subroutine reorder_tbc(tbc)
ci = 0 ci = 0
do i=1,N_det_generators do i=1,N_det_generators
if(ltbc(i)) then if(ltbc(i)) then
ci += 1 ci = ci+1
tbc(ci) = i tbc(ci) = i
end if end if
end do end do
@ -446,7 +447,7 @@ end subroutine
comb_step = 1d0/dfloat(comb_teeth) comb_step = 1d0/dfloat(comb_teeth)
do i=1,N_det_generators do i=1,N_det_generators
if(pt2_weight(i)/norm_left < comb_step/2d0) then if(pt2_weight(i)/norm_left < comb_step*.5d0) then
first_det_of_comb = i first_det_of_comb = i
exit exit
end if end if
@ -462,7 +463,10 @@ end subroutine
end do end do
first_det_of_teeth(comb_teeth+1) = N_det_generators + 1 first_det_of_teeth(comb_teeth+1) = N_det_generators + 1
first_det_of_teeth(1) = first_det_of_comb first_det_of_teeth(1) = first_det_of_comb
if(first_det_of_teeth(1) /= first_det_of_comb) stop "comb provider" if(first_det_of_teeth(1) /= first_det_of_comb) then
print *, 'Error in ', irp_here
stop "comb provider"
endif
END_PROVIDER END_PROVIDER