mirror of
https://github.com/LCPQ/quantum_package
synced 2025-01-05 11:00:10 +01:00
Cleaning in PT2 stoch
This commit is contained in:
parent
7cd0804147
commit
b2a5d497a0
@ -167,7 +167,7 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
|
|||||||
double precision, allocatable :: val(:)
|
double precision, allocatable :: val(:)
|
||||||
integer(bit_kind), allocatable :: det(:,:,:)
|
integer(bit_kind), allocatable :: det(:,:,:)
|
||||||
integer, allocatable :: task_id(:)
|
integer, allocatable :: task_id(:)
|
||||||
integer :: done, Nindex
|
integer :: Nindex
|
||||||
integer, allocatable :: index(:)
|
integer, allocatable :: index(:)
|
||||||
double precision, save :: time0 = -1.d0
|
double precision, save :: time0 = -1.d0
|
||||||
double precision :: time, timeLast, Nabove_old
|
double precision :: time, timeLast, Nabove_old
|
||||||
@ -249,11 +249,6 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
|
|||||||
if(Nabove(1) < 5d0) cycle
|
if(Nabove(1) < 5d0) cycle
|
||||||
call get_first_tooth(actually_computed, tooth)
|
call get_first_tooth(actually_computed, tooth)
|
||||||
|
|
||||||
done = 0
|
|
||||||
do i=first_det_of_teeth(tooth), first_det_of_teeth(tooth+1)-1
|
|
||||||
if(actually_computed(i)) done = done + 1
|
|
||||||
end do
|
|
||||||
|
|
||||||
E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1))
|
E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1))
|
||||||
if (tooth <= comb_teeth) then
|
if (tooth <= comb_teeth) then
|
||||||
prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - pt2_cweight(first_det_of_teeth(tooth)-1))
|
prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - pt2_cweight(first_det_of_teeth(tooth)-1))
|
||||||
@ -273,11 +268,9 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
|
|||||||
else
|
else
|
||||||
if (Nabove(tooth) > Nabove_old) then
|
if (Nabove(tooth) > Nabove_old) then
|
||||||
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, ''
|
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, ''
|
||||||
!print "(4(G23.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
|
|
||||||
Nabove_old = Nabove(tooth)
|
Nabove_old = Nabove(tooth)
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
!print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
|
|
||||||
end if
|
end if
|
||||||
end do pullLoop
|
end do pullLoop
|
||||||
|
|
||||||
@ -352,27 +345,6 @@ subroutine get_first_tooth(computed, first_teeth)
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine get_last_full_tooth(computed, last_tooth)
|
|
||||||
implicit none
|
|
||||||
logical, intent(in) :: computed(N_det_generators)
|
|
||||||
integer, intent(out) :: last_tooth
|
|
||||||
integer :: i, j, missing
|
|
||||||
|
|
||||||
last_tooth = 0
|
|
||||||
combLoop : do i=comb_teeth, 1, -1
|
|
||||||
missing = 1+ ishft(first_det_of_teeth(i+1)-first_det_of_teeth(i),-4) ! /16
|
|
||||||
do j=first_det_of_teeth(i), first_det_of_teeth(i+1)-1
|
|
||||||
if(.not.computed(j)) then
|
|
||||||
missing -= 1
|
|
||||||
if(missing < 0) cycle combLoop
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
last_tooth = i
|
|
||||||
exit
|
|
||||||
end do combLoop
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, size_tbc ]
|
BEGIN_PROVIDER [ integer, size_tbc ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -410,52 +382,6 @@ subroutine get_carlo_workbatch(computed, comb, Ncomb, tbc)
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine get_filling_teeth(computed, tbc)
|
|
||||||
implicit none
|
|
||||||
integer, intent(inout) :: tbc(0:size_tbc)
|
|
||||||
logical, intent(inout) :: computed(N_det_generators)
|
|
||||||
integer :: i, j, k, last_full, dets(comb_teeth)
|
|
||||||
|
|
||||||
call get_last_full_tooth(computed, last_full)
|
|
||||||
if(last_full /= 0) then
|
|
||||||
if (tbc(0) > size(tbc) - first_det_of_teeth(last_full+1) -2) then
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
k = tbc(0)+1
|
|
||||||
do j=1,first_det_of_teeth(last_full+1)-1
|
|
||||||
if(.not.(computed(j))) then
|
|
||||||
tbc(k) = j
|
|
||||||
k=k+1
|
|
||||||
computed(j) = .true.
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
tbc(0) = k-1
|
|
||||||
end if
|
|
||||||
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
subroutine reorder_tbc(tbc)
|
|
||||||
implicit none
|
|
||||||
integer, intent(inout) :: tbc(0:size_tbc)
|
|
||||||
logical, allocatable :: ltbc(:)
|
|
||||||
integer :: i, ci
|
|
||||||
|
|
||||||
allocate(ltbc(size_tbc))
|
|
||||||
ltbc(:) = .false.
|
|
||||||
do i=1,tbc(0)
|
|
||||||
ltbc(tbc(i)) = .true.
|
|
||||||
end do
|
|
||||||
|
|
||||||
ci = 0
|
|
||||||
do i=1,size_tbc
|
|
||||||
if(ltbc(i)) then
|
|
||||||
ci = ci+1
|
|
||||||
tbc(ci) = i
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
subroutine get_comb(stato, dets, ct)
|
subroutine get_comb(stato, dets, ct)
|
||||||
implicit none
|
implicit none
|
||||||
|
Loading…
Reference in New Issue
Block a user