10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-08-07 21:10:23 +02:00

Working on print in pt2 stoch

This commit is contained in:
Anthony Scemama 2017-04-24 18:20:45 +02:00
parent 963097e5d6
commit 2454862cb0
4 changed files with 32 additions and 20 deletions

View File

@ -56,7 +56,7 @@ let display_tty bar =
else else
Time.Span.of_float 0. Time.Span.of_float 0.
in in
Printf.printf "%s : [%s] %4.1f%% | %10s, ~%10s left\r%!" Printf.eprintf "%s : [%s] %4.1f%% | %10s, ~%10s left\r%!"
bar.title bar.title
hashes hashes
percent percent
@ -83,7 +83,7 @@ let display_file bar =
else else
Time.Span.of_float 0. Time.Span.of_float 0.
in in
Printf.printf "%5.2f %% in %20s, ~%20s left\n%!" Printf.eprintf "%5.2f %% in %20s, ~%20s left\n%!"
percent percent
(Time.Span.to_string running_time) (Time.Span.to_string running_time)
(Time.Span.to_string stop_time); (Time.Span.to_string stop_time);

View File

@ -128,8 +128,13 @@ program fci_zmq
double precision :: relative_error double precision :: relative_error
relative_error=1.d-3 relative_error=1.d-3
pt2 = 0.d0 pt2 = 0.d0
call ZMQ_pt2(pt2,relative_error) ! Stochastic PT2 if (N_states > 1) then
!call ZMQ_selection(0, pt2) ! Deterministic PT2 print *, 'Stochastic PT2'
call ZMQ_pt2(E_CI_before(1), pt2,relative_error) ! Stochastic PT2
else
print *, 'Deterministic PT2'
call ZMQ_selection(0, pt2) ! Deterministic PT2
endif
print *, 'Final step' print *, 'Final step'
print *, 'N_det = ', N_det print *, 'N_det = ', N_det
print *, 'N_states = ', N_states print *, 'N_states = ', N_states

View File

@ -25,7 +25,7 @@ subroutine run
threshold_selectors = 1.d0 threshold_selectors = 1.d0
threshold_generators = 1d0 threshold_generators = 1d0
relative_error = 1.d-3 relative_error = 1.d-3
call ZMQ_pt2(pt2, relative_error) call ZMQ_pt2(E_CI_before, pt2, relative_error)
print *, 'Final step' print *, 'Final step'
print *, 'N_det = ', N_det print *, 'N_det = ', N_det
print *, 'PT2 = ', pt2 print *, 'PT2 = ', pt2

View File

@ -3,7 +3,7 @@ BEGIN_PROVIDER [ integer, fragment_first ]
fragment_first = first_det_of_teeth(1) fragment_first = first_det_of_teeth(1)
END_PROVIDER END_PROVIDER
subroutine ZMQ_pt2(pt2,relative_error) subroutine ZMQ_pt2(E, pt2,relative_error)
use f77_zmq use f77_zmq
use selection_types use selection_types
@ -13,7 +13,7 @@ subroutine ZMQ_pt2(pt2,relative_error)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_to_qp_run_socket2 integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_to_qp_run_socket2
type(selection_buffer) :: b type(selection_buffer) :: b
integer, external :: omp_get_thread_num integer, external :: omp_get_thread_num
double precision, intent(in) :: relative_error double precision, intent(in) :: relative_error, E
double precision, intent(out) :: pt2(N_states) double precision, intent(out) :: pt2(N_states)
@ -46,8 +46,10 @@ subroutine ZMQ_pt2(pt2,relative_error)
pt2_detail = 0d0 pt2_detail = 0d0
time0 = omp_get_wtime() time0 = omp_get_wtime()
print *, "time - avg - err - n_combs"
generator_per_task = 1 generator_per_task = 1
print *, '========== ================ ================'
print *, ' Samples Energy Stat. Error'
print *, '========== ================ ================'
do while(.true.) do while(.true.)
call write_time(6) call write_time(6)
@ -55,7 +57,7 @@ subroutine ZMQ_pt2(pt2,relative_error)
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator)) call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
call create_selection_buffer(1, 1*2, b) call create_selection_buffer(1, 1*2, b)
Ncomb=size(comb) Ncomb=size(comb)/100
call get_carlo_workbatch(computed, comb, Ncomb, tbc) call get_carlo_workbatch(computed, comb, Ncomb, tbc)
call write_time(6) call write_time(6)
@ -100,7 +102,7 @@ subroutine ZMQ_pt2(pt2,relative_error)
!$OMP PRIVATE(i) !$OMP PRIVATE(i)
i = omp_get_thread_num() i = omp_get_thread_num()
if (i==0) then if (i==0) then
call pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, sum2above, Nabove, relative_error, pt2) call pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, sum2above, Nabove, relative_error, pt2)
else else
call pt2_slave_inproc(i) call pt2_slave_inproc(i)
endif endif
@ -162,7 +164,7 @@ subroutine pt2_slave_inproc(i)
call run_pt2_slave(1,i,pt2_e0_denominator) call run_pt2_slave(1,i,pt2_e0_denominator)
end end
subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, sum2above, Nabove, relative_error, pt2) subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, sum2above, Nabove, relative_error, pt2)
use f77_zmq use f77_zmq
use selection_types use selection_types
use bitmasks use bitmasks
@ -171,7 +173,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
integer, intent(in) :: Ncomb integer, intent(in) :: Ncomb
double precision, intent(inout) :: pt2_detail(N_states, N_det_generators) double precision, intent(inout) :: pt2_detail(N_states, N_det_generators)
double precision, intent(in) :: comb(Ncomb), relative_error double precision, intent(in) :: comb(Ncomb), relative_error, E
logical, intent(inout) :: computed(N_det_generators) logical, intent(inout) :: computed(N_det_generators)
integer, intent(in) :: tbc(0:size_tbc) integer, intent(in) :: tbc(0:size_tbc)
double precision, intent(inout) :: sumabove(comb_teeth), sum2above(comb_teeth), Nabove(comb_teeth) double precision, intent(inout) :: sumabove(comb_teeth), sum2above(comb_teeth), Nabove(comb_teeth)
@ -194,11 +196,12 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
integer :: done, Nindex integer :: done, Nindex
integer, allocatable :: index(:) integer, allocatable :: index(:)
double precision, save :: time0 = -1.d0 double precision, save :: time0 = -1.d0
double precision :: time, timeLast double precision :: time, timeLast, Nabove_old
double precision, external :: omp_get_wtime double precision, external :: omp_get_wtime
integer :: tooth, firstTBDcomb, orgTBDcomb integer :: tooth, firstTBDcomb, orgTBDcomb
integer, allocatable :: parts_to_get(:) integer, allocatable :: parts_to_get(:)
logical, allocatable :: actually_computed(:) logical, allocatable :: actually_computed(:)
Nabove_old = -1.d0
allocate(actually_computed(N_det_generators), parts_to_get(N_det_generators), & allocate(actually_computed(N_det_generators), parts_to_get(N_det_generators), &
pt2_mwen(N_states, N_det_generators) ) pt2_mwen(N_states, N_det_generators) )
@ -229,7 +232,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
endif endif
timeLast = time0 timeLast = time0
print *, 'N_deterministic = ', first_det_of_teeth(1)-1 ! print *, 'N_deterministic = ', first_det_of_teeth(1)-1
pullLoop : do while (more == 1) pullLoop : do while (more == 1)
call pull_pt2_results(zmq_socket_pull, Nindex, index, pt2_mwen, task_id, ntask) call pull_pt2_results(zmq_socket_pull, Nindex, index, pt2_mwen, task_id, ntask)
do i=1,Nindex do i=1,Nindex
@ -257,7 +260,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
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
print *, "PT2 : deterministic part not finished" ! print *, "PT2 : deterministic part not finished"
cycle pullLoop cycle pullLoop
end if end if
end do end do
@ -265,7 +268,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
double precision :: E0, avg, eqt, prop double precision :: E0, avg, eqt, prop
call do_carlo(tbc, Ncomb+1-firstTBDcomb, comb(firstTBDcomb), pt2_detail, actually_computed, sumabove, sum2above, Nabove) call do_carlo(tbc, Ncomb+1-firstTBDcomb, comb(firstTBDcomb), pt2_detail, actually_computed, sumabove, sum2above, Nabove)
firstTBDcomb = int(Nabove(1)) - orgTBDcomb + 1 firstTBDcomb = int(Nabove(1)) - orgTBDcomb + 1
if(Nabove(1) < 2d0) cycle if(Nabove(1) < 5d0) cycle
call get_first_tooth(actually_computed, tooth) call get_first_tooth(actually_computed, tooth)
done = 0 done = 0
@ -273,7 +276,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
if(actually_computed(i)) done = done + 1 if(actually_computed(i)) done = done + 1
end do end do
E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1)) E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1))
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))
prop = prop * pt2_weight_inv(first_det_of_teeth(tooth)) prop = prop * pt2_weight_inv(first_det_of_teeth(tooth))
E0 += pt2_detail(1,first_det_of_teeth(tooth)) * prop E0 += pt2_detail(1,first_det_of_teeth(tooth)) * prop
@ -282,12 +285,16 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su
time = omp_get_wtime() time = omp_get_wtime()
if (dabs(eqt/avg) < relative_error) then if (dabs(eqt/avg) < relative_error) then
pt2(1) = avg pt2(1) = avg
! exit pullLoop
else else
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) ! 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)
if (Nabove(tooth) > Nabove_old) then
print '(E10.1, X, F16.10, E16.3,A30)', Nabove(tooth), avg+E, eqt, ''
Nabove_old = Nabove(tooth)
endif
endif endif
end if end if
end do pullLoop end do pullLoop
print *, '========== ================ ================'
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_pull_socket(zmq_socket_pull) call end_zmq_pull_socket(zmq_socket_pull)
@ -323,7 +330,7 @@ end function
BEGIN_PROVIDER [ integer, comb_teeth ] BEGIN_PROVIDER [ integer, comb_teeth ]
implicit none implicit none
comb_teeth = 100 comb_teeth = 50
END_PROVIDER END_PROVIDER