LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-23 11:17:33 +02:00
Code Issues Releases Wiki Activity

real(4) dressing

Browse Source
This commit is contained in:
Yann Garniron 2018-04-30 09:33:25 +02:00
parent 12e527157c
commit 9966697ab2
2 changed files with 46 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
plugins/dress_zmq/dress_stoch_routines.irp.f
View File

@ -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

55
plugins/dress_zmq/run_dress_slave.irp.f
View File

@ -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