10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00

Fixed PT2 stoch

This commit is contained in:
Anthony Scemama 2017-05-05 15:08:51 +02:00
parent 4a043229b7
commit 49b413f486
4 changed files with 12 additions and 29 deletions

View File

@ -34,8 +34,6 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral pt2_weight psi_selectors provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral pt2_weight psi_selectors
!call random_seed()
computed = .false. computed = .false.
tbc(0) = first_det_of_comb - 1 tbc(0) = first_det_of_comb - 1
@ -72,7 +70,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, tbc(i) write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, tbc(i)
ipos += 20 ipos += 20
if (ipos > 63980) then if (ipos > 63980) then
call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20))) call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos)))
ipos=1 ipos=1
tasks = .True. tasks = .True.
endif endif
@ -81,7 +79,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, tbc(i) write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, tbc(i)
ipos += 20 ipos += 20
if (ipos > 63980) then if (ipos > 63980) then
call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20))) call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos)))
ipos=1 ipos=1
tasks = .True. tasks = .True.
endif endif
@ -89,7 +87,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
end if end if
end do end do
if (ipos > 1) then if (ipos > 1) then
call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20))) call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos)))
tasks = .True. tasks = .True.
endif endif
@ -237,6 +235,7 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
! print *, 'N_deterministic = ', first_det_of_teeth(1)-1 ! print *, 'N_deterministic = ', first_det_of_teeth(1)-1
pullLoop : do while (more == 1) pullLoop : do while (more == 1)
call pull_pt2_results(zmq_socket_pull, Nindex, index, pt2_mwen, task_id, ntask) call pull_pt2_results(zmq_socket_pull, Nindex, index, pt2_mwen, task_id, ntask)
do i=1,Nindex do i=1,Nindex
pt2_detail(1:N_states, index(i)) += pt2_mwen(1:N_states,i) pt2_detail(1:N_states, index(i)) += pt2_mwen(1:N_states,i)
@ -289,12 +288,12 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
if (dabs(eqt/avg) < relative_error) then if (dabs(eqt/avg) < relative_error) then
pt2(1) = avg pt2(1) = avg
else else
! print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
if (Nabove(tooth) > Nabove_old) then if (Nabove(tooth) > Nabove_old) then
print '(G10.3, X, F16.10, G16.3,A30)', Nabove(tooth), avg+E, eqt, '' print '(G10.3, X, F16.10, G16.3,A30)', Nabove(tooth), avg+E, eqt, ''
Nabove_old = Nabove(tooth) Nabove_old = Nabove(tooth)
endif endif
endif endif
!print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
end if end if
end do pullLoop end do pullLoop

View File

@ -17,7 +17,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
integer(ZMQ_PTR), external :: new_zmq_push_socket integer(ZMQ_PTR), external :: new_zmq_push_socket
integer(ZMQ_PTR) :: zmq_socket_push integer(ZMQ_PTR) :: zmq_socket_push
type(selection_buffer) :: buf, buf2 type(selection_buffer) :: buf
logical :: done logical :: done
double precision :: pt2(N_states) double precision :: pt2(N_states)
@ -47,18 +47,12 @@ subroutine run_pt2_slave(thread,iproc,energy)
if (done) then if (done) then
ctask = ctask - 1 ctask = ctask - 1
else else
integer :: i_generator, i_i_generator, N, subset integer :: i_generator, i_i_generator, subset
read (task,*) subset, index read (task,*) subset, index
!!!!!
N=1
!!!!!
if(buf%N == 0) then if(buf%N == 0) then
! Only first time ! Only first time
call create_selection_buffer(N, N*2, buf) call create_selection_buffer(1, 2, buf)
call create_selection_buffer(N, N*3, buf2)
else
if(N /= buf%N) stop "N changed... wtf man??"
end if end if
do i_i_generator=1, Nindex do i_i_generator=1, Nindex
i_generator = index i_generator = index
@ -67,18 +61,13 @@ subroutine run_pt2_slave(thread,iproc,energy)
enddo enddo
endif endif
if(done .or. ctask == size(task_id)) then if(done .or. (ctask == size(task_id)) ) then
if(buf%N == 0 .and. ctask > 0) stop "uninitialized selection_buffer" if(buf%N == 0 .and. ctask > 0) stop "uninitialized selection_buffer"
do i=1, ctask do i=1, ctask
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
end do end do
if(ctask > 0) then if(ctask > 0) then
call push_pt2_results(zmq_socket_push, Nindex, index, pt2_detail, task_id(1), ctask) call push_pt2_results(zmq_socket_push, Nindex, index, pt2_detail, task_id(1), ctask)
do i=1,buf%cur
call add_to_selection_buffer(buf2, buf%det(1,1,i), buf%val(i))
enddo
call sort_selection_buffer(buf2)
buf%mini = buf2%mini
pt2 = 0d0 pt2 = 0d0
pt2_detail(:,:Nindex) = 0d0 pt2_detail(:,:Nindex) = 0d0
buf%cur = 0 buf%cur = 0
@ -92,6 +81,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread) call end_zmq_push_socket(zmq_socket_push,thread)
call delete_selection_buffer(buf)
end subroutine end subroutine

View File

@ -74,6 +74,8 @@ subroutine run_selection_slave(thread,iproc,energy)
call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread) call end_zmq_push_socket(zmq_socket_push,thread)
call delete_selection_buffer(buf)
call delete_selection_buffer(buf2)
end subroutine end subroutine

View File

@ -93,7 +93,6 @@ subroutine selection_collector(b, N, pt2)
double precision, pointer :: val(:) double precision, pointer :: val(:)
integer(bit_kind), pointer :: det(:,:,:) integer(bit_kind), pointer :: det(:,:,:)
integer, allocatable :: task_id(:) integer, allocatable :: task_id(:)
integer :: done
real :: time, time0 real :: time, time0
type(selection_buffer) :: b2 type(selection_buffer) :: b2
@ -101,7 +100,6 @@ subroutine selection_collector(b, N, pt2)
zmq_socket_pull = new_zmq_pull_socket() zmq_socket_pull = new_zmq_pull_socket()
call create_selection_buffer(N, N*2, b2) call create_selection_buffer(N, N*2, b2)
allocate(task_id(N_det_generators)) allocate(task_id(N_det_generators))
done = 0
more = 1 more = 1
pt2(:) = 0d0 pt2(:) = 0d0
call CPU_TIME(time0) call CPU_TIME(time0)
@ -110,19 +108,13 @@ subroutine selection_collector(b, N, pt2)
pt2 += pt2_mwen pt2 += pt2_mwen
call merge_selection_buffers(b2,b) call merge_selection_buffers(b2,b)
! do i=1, N
! call add_to_selection_buffer(b, det(1,1,i), val(i))
! end do
do i=1, ntask do i=1, ntask
if(task_id(i) == 0) then if(task_id(i) == 0) then
print *, "Error in collector" print *, "Error in collector"
endif endif
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more) call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
end do end do
done += ntask
call CPU_TIME(time) call CPU_TIME(time)
! print *, "DONE" , done, time - time0
end do end do