diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 620605ff..5dfa8556 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -925,7 +925,6 @@ end E_CI_before = mrcc_E0_denominator(1) + nuclear_repulsion threshold_selectors = 1.d0 threshold_generators = 1d0 - !errr = errr / 2d0 if(errr /= 0d0) then errr = errr / 2d0 ! (-mrcc_E0_denominator(1) + mrcc_previous_E(1)) / 1d1 else @@ -934,7 +933,7 @@ end relative_error = errr print *, "RELATIVE ERROR", relative_error call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(relative_error)) - !errr = + mrcc_previous_E(:) = mrcc_E0_denominator(:) do i=N_det_non_ref,1,-1 delta_ii_mrcc_zmq(:,1) -= delta_ij_mrcc_zmq(:, i, 1) / psi_ref_coef(1,1) * psi_non_ref_coef(i, 1) @@ -950,7 +949,6 @@ END_PROVIDER use bitmasks implicit none integer :: i, j, i_state - !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc if(mrmode == 4) then do i = 1, N_det_ref diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index 115d1749..7d1ddd8d 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -516,7 +516,7 @@ end integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull integer :: KKsize = 1000000 - + integer, external :: add_task_to_taskserver call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'mrsc2') diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index 1ad9b8da..a6c893b4 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -5,7 +5,7 @@ END_PROVIDER subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) - use dress_types + !use dress_types use f77_zmq implicit none @@ -24,14 +24,14 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) double precision, external :: omp_get_wtime double precision :: time - double precision :: w(N_states) - + double precision :: w!(N_states) + integer, external :: add_task_to_taskserver provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral mrcc_weight psi_selectors - w(:) = 0.d0 - w(mrcc_stoch_istate) = 1.d0 + w = 0.d0 + w = 1.d0 call update_psi_average_norm_contrib(w) @@ -48,7 +48,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) integer, external :: zmq_put_N_det_generators integer, external :: zmq_put_N_det_selectors integer, external :: zmq_put_dvector - + integer, external :: zmq_set_running if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then stop 'Unable to put psi on ZMQ server' endif @@ -98,7 +98,6 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) stop 'Unable to add task to task server' endif endif - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then print *, irp_here, ': Failed in zmq_set_running' endif @@ -107,7 +106,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) !$OMP PRIVATE(i) i = omp_get_thread_num() if (i==0) then - call mrcc_collector(zmq_socket_pull,E(mrcc_stoch_istate), relative_error, delta, delta_s2, mrcc) + call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) else call mrcc_slave_inproc(i) @@ -152,7 +151,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR), external :: new_zmq_pull_socket - integer(ZMQ_PTR) :: zmq_socket_pull + !integer(ZMQ_PTR) :: zmq_socket_pull integer :: more integer :: i, j, k, i_state, N, ntask @@ -167,6 +166,8 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m logical, allocatable :: actually_computed(:) integer :: total_computed + delta = 0d0 + delta_s2 = 0d0 allocate(delta_det(N_states, N_det_non_ref, 0:comb_teeth+1, 2)) allocate(cp(N_states, N_det_non_ref, N_cp, 2), mrcc_detail(N_states, N_det_generators)) allocate(delta_loc(N_states, N_det_non_ref, 2)) @@ -191,7 +192,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m actually_computed = .false. zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - zmq_socket_pull = new_zmq_pull_socket() + !zmq_socket_pull = new_zmq_pull_socket() allocate(task_id(N_det_generators), ind(1)) more = 1 if (time0 < 0.d0) then @@ -225,7 +226,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m toothMwen = tooth_of_det(ind(i)) fracted = (toothMwen /= 0) if(fracted) fracted = (ind(i) == first_det_of_teeth(toothMwen)) - + if(fracted) then delta_det(:,:,toothMwen-1, 1) += delta_loc(:,:,1) * (1d0-fractage(toothMwen)) delta_det(:,:,toothMwen-1, 2) += delta_loc(:,:,2) * (1d0-fractage(toothMwen)) @@ -262,7 +263,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m do i=2,N_det_generators if(.not. actually_computed(mrcc_jobs(i))) then - print *, "first not comp", i cur_cp = done_cp_at(i-1) exit end if @@ -303,7 +303,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m print *, irp_here, ': Error in sending abort signal (2)' endif endif - else if (cur_cp > old_cur_cp) then old_cur_cp = cur_cp @@ -316,7 +315,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m end do pullLoop if(total_computed == N_det_generators) then - print *, "TOTALLY COMPUTED" delta = 0d0 delta_s2 = 0d0 do i=comb_teeth+1,0,-1 @@ -325,22 +323,17 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m end do else - delta = cp(:,:,cur_cp,1) delta_s2 = cp(:,:,cur_cp,2) - do i=cp_first_tooth(cur_cp)-1,0,-1 delta += delta_det(:,:,i,1) delta_s2 += delta_det(:,:,i,2) end do end if - mrcc(1) = E - 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) end subroutine