diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index d80d10c4..3c47ecab 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -177,6 +177,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, double precision, intent(out) :: delta(N_states, N_det) double precision, intent(out) :: delta_s2(N_states, N_det) double precision, allocatable :: delta_loc(:,:,:), delta_det(:,:,:,:) + real, allocatable :: delta_loc4(:,:,:) double precision, allocatable :: dress_detail(:,:) double precision :: dress_mwen(N_states) integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket @@ -209,6 +210,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, allocate(delta_det(N_states, N_det, 0:comb_teeth+1, 2)) allocate(cp(N_states, N_det, N_cp, 2), dress_detail(N_states, N_det)) allocate(delta_loc(N_states, N_det, 2)) + allocate(delta_loc4(N_states, N_det, 2)) dress_detail = 0d0 delta_det = 0d0 cp = 0d0 @@ -235,14 +237,20 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, timeLast = time0 cur_cp = 0 old_cur_cp = 0 - logical :: loop, last + logical :: loop, last, floop integer, allocatable :: sparse(:) allocate(sparse(0:N_det)) + floop = .true. loop = .true. + pullLoop : do while (loop) - call pull_dress_results(zmq_socket_pull, ind, last, delta_loc(1,1,1), int_buf, double_buf, det_buf, N_buf, task_id, sparse, dress_mwen) + call pull_dress_results(zmq_socket_pull, ind, last, delta_loc, delta_loc4, int_buf, double_buf, det_buf, N_buf, task_id, sparse, dress_mwen) call dress_pulled(ind, int_buf, double_buf, det_buf, N_buf) - + if(floop) then + call wall_time(time) + print *, "FIRST PULL", time-time0 + floop = .false. + end if integer, external :: zmq_delete_tasks diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index 11229c1b..e57b8cf7 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -108,6 +108,7 @@ subroutine push_dress_results(zmq_socket_push, ind, last, delta_loc, int_buf, do integer(ZMQ_PTR), intent(in) :: zmq_socket_push double precision, intent(inout) :: delta_loc(N_states, N_det, 2) + real(kind=4), allocatable :: delta_loc4(:,:,:) double precision, intent(in) :: double_buf(*) logical, intent(in) :: last integer, intent(in) :: int_buf(*) @@ -115,15 +116,15 @@ subroutine push_dress_results(zmq_socket_push, ind, last, delta_loc, int_buf, do integer, intent(in) :: N_bufi(3) integer :: N_buf(3) integer, intent(in) :: ind, task_id - integer :: rc, i, j + integer :: rc, i, j, k, l double precision :: tmp(N_states,2) integer, allocatable :: sparse(:) integer :: sparsei double precision :: contrib(N_states) - + contrib = 0d0 allocate(sparse(N_det)) - + allocate(delta_loc4(N_states, N_det, 2)) rc = f77_zmq_send( zmq_socket_push, ind, 4, ZMQ_SNDMORE) if(rc /= 4) stop "push" @@ -139,8 +140,12 @@ subroutine push_dress_results(zmq_socket_push, ind, last, delta_loc, int_buf, do if(delta_loc(j,i,1) /= 0d0 .or. delta_loc(j,i,2) /= 0d0) then sparsei += 1 sparse(sparsei) = i - delta_loc(:,sparsei,:) = delta_loc(:,i,:) - contrib(:) += delta_loc(:,sparsei, 1) * psi_coef(i, :) + do k=1,2 + do l=1,N_states + delta_loc4(l,sparsei,k) = real(delta_loc(l,i,k), kind=4) + end do + end do + contrib(:) += delta_loc(:,i, 1) * psi_coef(i, :) end if end do end do @@ -156,17 +161,17 @@ subroutine push_dress_results(zmq_socket_push, ind, last, delta_loc, int_buf, do if(rc /= 4*sparsei) stop "push" - rc = f77_zmq_send( zmq_socket_push, delta_loc(1,1,1), 8*N_states*sparsei, ZMQ_SNDMORE) - if(rc /= 8*N_states*sparsei) stop "push" + rc = f77_zmq_send( zmq_socket_push, delta_loc4(1,1,1), 4*N_states*sparsei, ZMQ_SNDMORE) + if(rc /= 4*N_states*sparsei) stop "push" - rc = f77_zmq_send( zmq_socket_push, delta_loc(1,1,2), 8*N_states*sparsei, ZMQ_SNDMORE) - if(rc /= 8*N_states*sparsei) stop "push" + rc = f77_zmq_send( zmq_socket_push, delta_loc4(1,1,2), 4*N_states*sparsei, ZMQ_SNDMORE) + if(rc /= 4*N_states*sparsei) stop "push" - do i=sparsei,1 - tmp(:,:) = delta_loc(:,i,:) - delta_loc(:,i,:) = 0d0 - delta_loc(:,sparse(i),:) = tmp(:,:) - end do + !do i=sparsei,1 + ! tmp(:,:) = delta_loc(:,i,:) + ! delta_loc(:,i,:) = 0d0 + ! delta_loc(:,sparse(i),:) = tmp(:,:) + !end do end if @@ -220,7 +225,7 @@ IRP_ENDIF end subroutine -subroutine pull_dress_results(zmq_socket_pull, ind, last, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id, sparse, contrib) +subroutine pull_dress_results(zmq_socket_pull, ind, last, delta_loc, delta_loc4, int_buf, double_buf, det_buf, N_buf, task_id, sparse, contrib) use f77_zmq implicit none integer(ZMQ_PTR), intent(in) :: zmq_socket_pull @@ -232,8 +237,10 @@ subroutine pull_dress_results(zmq_socket_pull, ind, last, delta_loc, int_buf, do integer, intent(out) :: sparse(0:N_det) integer, intent(out) :: ind integer, intent(out) :: task_id - integer :: rc, i, sparsen + integer :: rc, i, j, k, sparsen integer, intent(out) :: N_buf(3) + real(kind=4), intent(out) :: delta_loc4(N_states, N_det, 2) + rc = f77_zmq_recv( zmq_socket_pull, ind, 4, 0) @@ -254,11 +261,19 @@ subroutine pull_dress_results(zmq_socket_pull, ind, last, delta_loc, int_buf, do if(rc /= 4*sparse(0)) stop "pullc" - rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,1,1), N_states*8*sparse(0), 0) - if(rc /= 8*N_states*sparse(0)) stop "pullc" + rc = f77_zmq_recv( zmq_socket_pull, delta_loc4(1,1,1), N_states*4*sparse(0), 0) + if(rc /= 4*N_states*sparse(0)) stop "pullc" - rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,1,2), N_states*8*sparse(0), 0) - if(rc /= 8*N_states*sparse(0)) stop "pulld" + rc = f77_zmq_recv( zmq_socket_pull, delta_loc4(1,1,2), N_states*4*sparse(0), 0) + if(rc /= 4*N_states*sparse(0)) stop "pulld" + + do j=1,2 + do i=1,sparse(0) + do k=1,N_states + delta_loc(k,i,j) = real(delta_loc4(k,i,j), kind=8) + end do + end do + end do else contrib = 0d0 end if