From 502fd9d1fd7475fb719bd20cc98a11c7604578e7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 26 Sep 2018 15:53:54 +0200 Subject: [PATCH] Fixed sBK --- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 3 +-- plugins/dress_zmq/dress_stoch_routines.irp.f | 22 +++++++++++++------- plugins/dress_zmq/run_dress_slave.irp.f | 22 ++++++++++---------- 3 files changed, 27 insertions(+), 20 deletions(-) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 3978cd2a..f12eb719 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -15,8 +15,7 @@ END_PROVIDER integer :: i integer :: e e = elec_num - n_core_orb * 2 - pt2_n_tasks_max = 1+min((e*(e-1))/2, int(dsqrt(dble(N_det_generators)))/10) - pt2_n_tasks_max = 1 + pt2_n_tasks_max = 1+min((e*(e-1))/2, int(dsqrt(dble(N_det_selectors)))/10) do i=1,N_det_generators if (maxval(dabs(psi_coef_sorted_gen(i,1:N_states))) > 0.001d0) then pt2_F(i) = pt2_n_tasks_max diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 9280b688..dddfaf9c 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -30,7 +30,7 @@ END_PROVIDER pt2_N_teeth = 1 else pt2_minDetInFirstTeeth = min(5, N_det_generators) - do pt2_N_teeth=20,2,-1 + do pt2_N_teeth=100,2,-1 if(testTeethBuilding(pt2_minDetInFirstTeeth, pt2_N_teeth)) exit end do end if @@ -89,7 +89,7 @@ logical function testTeethBuilding(minF, N) end function BEGIN_PROVIDER[ integer, dress_N_cp_max ] - dress_N_cp_max = 64 + dress_N_cp_max = 28 END_PROVIDER BEGIN_PROVIDER[integer, pt2_J, (N_det_generators)] @@ -102,6 +102,7 @@ END_PROVIDER pt2_J = pt2_J_ dress_R1 = dress_R1_ +!return do m=1,dress_N_cp nmov = 0 @@ -209,6 +210,11 @@ END_PROVIDER enddo dress_N_cp = m-1 + if (dress_N_cp == 0) then + print *, irp_here, 'dress_N_cp = 0' + stop -1 + endif + dress_R1_(dress_N_cp) = N_j dress_M_m(dress_N_cp) = N_c !!!!!!!!!!!!!! @@ -510,6 +516,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, more = 1 do while (.not. found) +print *, 'm, dotfm', m, dot_f(m) if(dot_f(m) == 0) then E0 = 0 do i=dress_dot_n_0(m),1,-1 @@ -527,16 +534,17 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, end do end do t = dress_dot_t(m) +!print *, 'm dressncp', m, dress_N_cp avg = E0 + S(t) / dble(c) if (c > 2) then eqt = dabs((S2(t) / c) - (S(t)/c)**2) - eqt = sqrt(eqt / (dble(c)-1.5d0)) - error = eqt + error = sqrt(eqt / (dble(c)-1.5d0)) time = omp_get_wtime() - print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E(istate), eqt, time-time0, '' + print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E(istate), error, time-time0, '' + else if ( m==dress_N_cp ) then + error = 0.d0 else - eqt = 1.d0 - error = eqt + error =1.d0 endif m += 1 if(dabs(error / avg) <= relative_error) then diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index 1fd414ab..4480ef1a 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -36,7 +36,7 @@ subroutine run_dress_slave(thread,iproce,energy) ! integer(kind=OMP_LOCK_KIND) :: lck_det(0:pt2_N_teeth+1) ! integer(kind=OMP_LOCK_KIND) :: lck_sto(dress_N_cp) double precision :: fac - integer :: ending + integer :: ending, ending_tmp integer, external :: zmq_get_dvector, zmq_get_int ! double precision, external :: omp_get_wtime double precision :: time, time0 @@ -96,7 +96,8 @@ subroutine run_dress_slave(thread,iproce,energy) call push_dress_results(zmq_socket_push, 0, 0, edI_task, edI_index, breve_delta_m, task_buf, ntask_buf) end if - !$OMP FLUSH + m=0 + !$OMP BARRIER do while( (cp_done > cp_sent) .or. (m /= dress_N_cp+1) ) !$OMP CRITICAL (send) if(ntask_tbd == 0) then @@ -116,13 +117,13 @@ subroutine run_dress_slave(thread,iproce,energy) ntask_tbd -= 1 else m = dress_N_cp + 1 - i= zmq_get_int(zmq_to_qp_run_socket, worker_id, "ending", ending) + if (zmq_get_int(zmq_to_qp_run_socket, worker_id, "ending", ending_tmp) /= -1) then + ending = ending_tmp + endif end if will_send = 0 cp_max(iproc) = m -! print *, cp_max(:) -! print *, '' cp_done = minval(cp_max)-1 if(cp_done > cp_sent) then will_send = cp_sent + 1 @@ -147,6 +148,7 @@ subroutine run_dress_slave(thread,iproce,energy) edI_index(n_tasks) = i end if end do +write(0,*) 'will send', will_send, n_tasks call push_dress_results(zmq_socket_push, will_send, sum_f, edI_task, edI_index, & breve_delta_m, task_buf, n_tasks) end if @@ -160,7 +162,6 @@ subroutine run_dress_slave(thread,iproce,energy) time0 = omp_get_wtime() call alpha_callback(breve_delta_m, i_generator, subset, pt2_F(i_generator), iproc) time = omp_get_wtime() -!print '(I0.11, I4, A12, F12.3)', i_generator, subset, "GREPMETIME", time-time0 t = dress_T(i_generator) !$OMP CRITICAL(t_crit) @@ -200,7 +201,6 @@ subroutine run_dress_slave(thread,iproce,energy) ntask_buf = 0 end if end if - !$OMP FLUSH end do !$OMP BARRIER @@ -208,11 +208,11 @@ subroutine run_dress_slave(thread,iproce,energy) call push_dress_results(zmq_socket_push, 0, 0, edI_task, edI_index, breve_delta_m, task_buf, ntask_buf) ntask_buf = 0 end if - !$OMP SINGLE - if(purge_task_id /= 0) then - do while(ending == dress_N_cp+1) + + !$OMP SINGLE + if(purge_task_id /= 0) then + do while (zmq_get_int(zmq_to_qp_run_socket, worker_id, "ending", ending) == -1) call sleep(1) - i= zmq_get_int(zmq_to_qp_run_socket, worker_id, "ending", ending) end do will_send = ending