diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 31598181..02058dfb 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -233,7 +233,6 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, absolute_error, pt2 end do end if end do - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) end subroutine diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 767c4598..faf26c8a 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -27,22 +27,10 @@ BEGIN_PROVIDER [ integer, dress_N_cp_max ] dress_N_cp_max = 100 END_PROVIDER -BEGIN_PROVIDER[ integer, dress_M_m, (dress_N_cp_max)] - implicit none - integer :: i - - do i=1,dress_N_cp_max-1 - dress_M_m(i) = N_det_generators * i / (dress_N_cp_max+1) - end do - dress_M_m(1) = 1 - dress_M_m(dress_N_cp_max) = N_det_generators+1 -END_PROVIDER - - - BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)] + BEGIN_PROVIDER[ integer, dress_M_m, (dress_N_cp_max)] +&BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)] &BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)] -&BEGIN_PROVIDER[ integer, dress_R, (0:N_det_generators)] &BEGIN_PROVIDER[ integer, dress_R1, (0:N_det_generators)] &BEGIN_PROVIDER[ double precision, dress_M_mi, (dress_N_cp_max, N_det_generators+1)] &BEGIN_PROVIDER [ integer, dress_P, (N_det_generators) ] @@ -59,12 +47,17 @@ END_PROVIDER dress_M_mi = 0d0 tilde_M = 0d0 - dress_R(:) = 0 dress_R1(:) = 0 N_c = 0 N_j = pt2_n_0(1) d(:) = .false. + do i=1,dress_N_cp_max-1 + dress_M_m(i) = N_det_generators * i / (dress_N_cp_max+1) + end do + dress_M_m(1) = 1 + dress_M_m(dress_N_cp_max) = N_det_generators+1 + do i=1,N_j d(i) = .true. pt2_J(i) = i @@ -103,7 +96,6 @@ END_PROVIDER if(N_c == dress_M_m(m)) then dress_R1(m) = N_j - dress_R(N_j) = N_c dress_M_mi(m, :N_det_generators) = tilde_M(:) m += 1 end if @@ -111,7 +103,7 @@ END_PROVIDER dress_N_cp = m-1 dress_R1(dress_N_cp) = N_j - + dress_M_m(dress_N_cp) = N_c !!!!!!!!!!!!!! do m=1,dress_N_cp do i=dress_R1(m-1)+1, dress_R1(m) @@ -263,6 +255,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error) !!$OMP END PARALLEL delta_out(dress_stoch_istate,1:N_det) = delta(dress_stoch_istate,1:N_det) delta_s2_out(dress_stoch_istate,1:N_det) = delta_s2(dress_stoch_istate,1:N_det) + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress') print *, '========== ================= ================= =================' @@ -401,25 +394,23 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, S2(p) += x**2 end do end do - t = dress_dot_t(m) - avg = S(t) / dble(c) - eqt = (S2(t) / c) - (S(t)/c)**2 - eqt = sqrt(eqt / dble(c-1)) - error = eqt - time = omp_get_wtime() - print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0+E(dress_stoch_istate), eqt, time-time0, '' - m += 1 - if(eqt <= relative_error) then - print *, "ABORT" + t = dress_dot_t(m) + avg = S(t) / dble(c) + eqt = (S2(t) / c) - (S(t)/c)**2 + eqt = sqrt(eqt / dble(c-1)) + error = eqt + time = omp_get_wtime() + print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0, eqt, time-time0, '' + m += 1 + if(eqt <= 0d0*relative_error) then + if (zmq_abort(zmq_to_qp_run_socket) == -1) then + call sleep(1) if (zmq_abort(zmq_to_qp_run_socket) == -1) then - call sleep(1) - if (zmq_abort(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Error in sending abort signal (2)' - endif + print *, irp_here, ': Error in sending abort signal (2)' endif - end if + endif + end if else - task_id = 0 do call pull_dress_results(zmq_socket_pull, m_task, f, edI_task, edI_index, breve_delta_m, task_id, n_tasks) if(task_id == 0) exit diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index 513cdbda..6941b7b2 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -46,7 +46,7 @@ subroutine run_dress_slave(thread,iproce,energy) edI = 0d0 f = 0 - delta_det = 0d9 + delta_det = 0d0 cp = 0d0 task(:) = CHAR(0) @@ -64,14 +64,13 @@ subroutine run_dress_slave(thread,iproce,energy) will_send = 0 double precision :: hij, sij, tmp - !call i_h_j_s2(psi_det(1,1,1),psi_det(1,1,2),N_int,hij, sij) hij = E0_denominator(1) !PROVIDE BEFORE OMP PARALLEL !$OMP PARALLEL DEFAULT(SHARED) & !$OMP PRIVATE(breve_delta_m, task, task_id) & - !$OMP PRIVATE(fac,m) & - !$OMP PRIVATE(i, will_send, i_generator, subset, iproc) & + !$OMP PRIVATE(tmp,fac,m,l,t,sum_f,n_tasks) & + !$OMP PRIVATE(i,p,will_send, i_generator, subset, iproc) & !$OMP PRIVATE(zmq_to_qp_run_socket, zmq_socket_push, worker_id) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() @@ -117,15 +116,13 @@ subroutine run_dress_slave(thread,iproce,energy) breve_delta_m(:,:,2) += cp(:,:,l,2) end do - breve_delta_m(:,:,:) = breve_delta_m(:,:,:) / dress_M_m(will_send) !/ cps_N(cur_cp) + breve_delta_m(:,:,:) = breve_delta_m(:,:,:) / dress_M_m(will_send) do t=dress_dot_t(will_send)-1,0,-1 breve_delta_m(:,:,1) = breve_delta_m(:,:,1) + delta_det(:,:,t,1) breve_delta_m(:,:,2) = breve_delta_m(:,:,2) + delta_det(:,:,t,2) end do - - call omp_set_lock(sending) n_tasks = 0 sum_f = 0 @@ -137,7 +134,6 @@ subroutine run_dress_slave(thread,iproce,energy) sum_f += f(i) end if end do -!!!!call pull_dress_results(zmq_socket_pull, m_task, f, edI_task, edI_index, breve_delta_m, task_id, n_tasks) call push_dress_results(zmq_socket_push, will_send, sum_f, edI_task, edI_index, breve_delta_m, 0, n_tasks) call omp_unset_lock(sending) end if @@ -145,11 +141,9 @@ subroutine run_dress_slave(thread,iproce,energy) if(m /= dress_N_cp+1) then !UPDATE i_generator - breve_delta_m(:,:,:) = 0d0 call generator_start(i_generator, iproc) - call alpha_callback(breve_delta_m, i_generator, subset, pt2_F(i_generator)*0 + 1, iproc) t = dress_T(i_generator) @@ -159,9 +153,9 @@ subroutine run_dress_slave(thread,iproce,energy) delta_det(:,:,t, 2) += breve_delta_m(:,:,2) call omp_unset_lock(lck_det(t)) - do p=1,dress_N_cp ! m, dress_N_cp - if(dress_e(i_generator, p) /= 0) then - fac = dress_e(i_generator, p) * pt2_W_T / pt2_w(i_generator) + do p=1,dress_N_cp + if(dress_e(i_generator, p) /= 0d0) then + fac = dress_e(i_generator, p) call omp_set_lock(lck_sto(p)) cp(:,:,p,1) += breve_delta_m(:,:,1) * fac cp(:,:,p,2) += breve_delta_m(:,:,2) * fac @@ -170,11 +164,11 @@ subroutine run_dress_slave(thread,iproce,energy) end do tmp = 0d0 - do i=1,N_det + do i=N_det,1,-1 tmp += psi_coef(i, dress_stoch_istate)*breve_delta_m(dress_stoch_istate, i, 1) end do !$OMP ATOMIC - edI(i_generator) += tmp! dot_product(psi_det_coef(:, dress_stoch_istate), breve_delta_m(dress_stoch_istate, :, 1)) + edI(i_generator) += tmp !$OMP ATOMIC f(i_generator) += 1 !push bidon