diff --git a/ocaml/Charge.ml b/ocaml/Charge.ml index b40469d2..714a5690 100644 --- a/ocaml/Charge.ml +++ b/ocaml/Charge.ml @@ -1,6 +1,6 @@ -open Core.Std;; +open Core.Std -type t = float with sexp;; +type t = float with sexp let of_float x = x let of_int i = Float.of_int i @@ -14,5 +14,4 @@ let to_string x = Printf.sprintf "+%f" x else Printf.sprintf "%f" x -;; diff --git a/ocaml/Progress_bar.ml b/ocaml/Progress_bar.ml index b8e97a59..3473ac4b 100644 --- a/ocaml/Progress_bar.ml +++ b/ocaml/Progress_bar.ml @@ -22,6 +22,11 @@ let update ~cur_value bar = let increment_end bar = { bar with end_value=(bar.end_value +. 1.) ; dirty=false } +let clear bar = + Printf.eprintf " \r%!"; + None + + let increment_cur bar = { bar with cur_value=(bar.cur_value +. 1.) ; dirty=true } @@ -56,7 +61,7 @@ let display_tty bar = else Time.Span.of_float 0. in - Printf.printf "%s : [%s] %4.1f%% | %10s, ~%10s left\r%!" + Printf.eprintf "%s : [%s] %4.1f%% | %10s, ~%10s left\r%!" bar.title hashes percent @@ -83,7 +88,7 @@ let display_file bar = else Time.Span.of_float 0. in - Printf.printf "%5.2f %% in %20s, ~%20s left\n%!" + Printf.eprintf "%5.2f %% in %20s, ~%20s left\n%!" percent (Time.Span.to_string running_time) (Time.Span.to_string stop_time); diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index abc2de1d..0128c3c3 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -212,7 +212,7 @@ let end_job msg program_state rep_socket pair_socket = reply_ok rep_socket; { program_state with state = None ; - progress_bar = None ; + progress_bar = Progress_bar.clear (); } in diff --git a/plugins/Full_CI_ZMQ/fci_zmq.irp.f b/plugins/Full_CI_ZMQ/fci_zmq.irp.f index f0cfe678..0deb0ca4 100644 --- a/plugins/Full_CI_ZMQ/fci_zmq.irp.f +++ b/plugins/Full_CI_ZMQ/fci_zmq.irp.f @@ -128,8 +128,13 @@ program fci_zmq double precision :: relative_error relative_error=1.d-3 pt2 = 0.d0 - call ZMQ_pt2(pt2,relative_error) ! Stochastic PT2 - !call ZMQ_selection(0, pt2) ! Deterministic PT2 + if (N_states == 1) then + 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 *, 'N_det = ', N_det print *, 'N_states = ', N_states diff --git a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f index 914e7138..f40fa055 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f @@ -25,7 +25,7 @@ subroutine run threshold_selectors = 1.d0 threshold_generators = 1d0 relative_error = 1.d-3 - call ZMQ_pt2(pt2, relative_error) + call ZMQ_pt2(E_CI_before, pt2, relative_error) print *, 'Final step' print *, 'N_det = ', N_det print *, 'PT2 = ', pt2 diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 9a5f2fa8..784ca8fa 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -3,7 +3,7 @@ BEGIN_PROVIDER [ integer, fragment_first ] fragment_first = first_det_of_teeth(1) END_PROVIDER -subroutine ZMQ_pt2(pt2,relative_error) +subroutine ZMQ_pt2(E, pt2,relative_error) use f77_zmq 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 type(selection_buffer) :: b 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) @@ -32,7 +32,7 @@ subroutine ZMQ_pt2(pt2,relative_error) sum2above = 0d0 Nabove = 0d0 - provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral pt2_weight + provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral pt2_weight psi_selectors !call random_seed() @@ -46,19 +46,19 @@ subroutine ZMQ_pt2(pt2,relative_error) pt2_detail = 0d0 time0 = omp_get_wtime() - print *, "time - avg - err - n_combs" generator_per_task = 1 + print *, '========== ================ ================' + print *, ' Samples Energy Stat. Error' + print *, '========== ================ ================' do while(.true.) - call write_time(6) - call new_parallel_job(zmq_to_qp_run_socket,"pt2") + call new_parallel_job(zmq_to_qp_run_socket,'pt2') 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) - Ncomb=size(comb) + Ncomb=size(comb)/100 call get_carlo_workbatch(computed, comb, Ncomb, tbc) - call write_time(6) integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket @@ -100,7 +100,7 @@ subroutine ZMQ_pt2(pt2,relative_error) !$OMP PRIVATE(i) i = omp_get_thread_num() 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 call pt2_slave_inproc(i) endif @@ -121,6 +121,7 @@ subroutine ZMQ_pt2(pt2,relative_error) exit endif end do + print *, '========== ================ ================' deallocate(pt2_detail, comb, computed, tbc) @@ -162,7 +163,7 @@ subroutine pt2_slave_inproc(i) call run_pt2_slave(1,i,pt2_e0_denominator) 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 selection_types use bitmasks @@ -171,7 +172,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su integer, intent(in) :: Ncomb 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) integer, intent(in) :: tbc(0:size_tbc) double precision, intent(inout) :: sumabove(comb_teeth), sum2above(comb_teeth), Nabove(comb_teeth) @@ -194,11 +195,12 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su integer :: done, Nindex integer, allocatable :: index(:) double precision, save :: time0 = -1.d0 - double precision :: time, timeLast + double precision :: time, timeLast, Nabove_old double precision, external :: omp_get_wtime integer :: tooth, firstTBDcomb, orgTBDcomb integer, allocatable :: parts_to_get(:) logical, allocatable :: actually_computed(:) + Nabove_old = -1.d0 allocate(actually_computed(N_det_generators), parts_to_get(N_det_generators), & pt2_mwen(N_states, N_det_generators) ) @@ -228,8 +230,11 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su time0 = omp_get_wtime() endif timeLast = time0 + + call get_first_tooth(actually_computed, tooth) + Nabove_old = Nabove(tooth) - print *, 'N_deterministic = ', first_det_of_teeth(1)-1 +! print *, 'N_deterministic = ', first_det_of_teeth(1)-1 pullLoop : do while (more == 1) call pull_pt2_results(zmq_socket_pull, Nindex, index, pt2_mwen, task_id, ntask) do i=1,Nindex @@ -257,7 +262,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su timeLast = time do i=1, first_det_of_teeth(1)-1 if(.not.(actually_computed(i))) then - print *, "PT2 : deterministic part not finished" +! print *, "PT2 : deterministic part not finished" cycle pullLoop end if end do @@ -265,7 +270,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su double precision :: E0, avg, eqt, prop call do_carlo(tbc, Ncomb+1-firstTBDcomb, comb(firstTBDcomb), pt2_detail, actually_computed, sumabove, sum2above, Nabove) firstTBDcomb = int(Nabove(1)) - orgTBDcomb + 1 - if(Nabove(1) < 2d0) cycle + if(Nabove(1) < 5d0) cycle call get_first_tooth(actually_computed, tooth) done = 0 @@ -273,7 +278,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su 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)) 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)) E0 += pt2_detail(1,first_det_of_teeth(tooth)) * prop @@ -282,9 +287,12 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su time = omp_get_wtime() if (dabs(eqt/avg) < relative_error) then pt2(1) = avg -! exit pullLoop 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 '(G10.3, X, F16.10, G16.3,A30)', Nabove(tooth), avg+E, eqt, '' + Nabove_old = Nabove(tooth) + endif endif end if end do pullLoop @@ -323,7 +331,7 @@ end function BEGIN_PROVIDER [ integer, comb_teeth ] implicit none - comb_teeth = 100 + comb_teeth = 50 END_PROVIDER diff --git a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f b/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f index 306320f7..46250be6 100644 --- a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f +++ b/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f @@ -37,7 +37,7 @@ subroutine run_wf do - call wait_for_states(states,zmq_state,2) + call wait_for_states(states,zmq_state,3) if(trim(zmq_state) == 'Stopped') then diff --git a/src/Utils/sort.irp.f b/src/Utils/sort.irp.f index bb93d44f..ee1e4cca 100644 --- a/src/Utils/sort.irp.f +++ b/src/Utils/sort.irp.f @@ -359,6 +359,10 @@ BEGIN_TEMPLATE integer :: err !DIR$ ATTRIBUTES ALIGN : 128 :: iorder1,iorder2, x2, x1 + if (isize < 2) then + return + endif + if (iradix == -1) then ! Sort Positive and negative allocate(x1(isize),iorder1(isize), x2(isize),iorder2(isize),stat=err)