10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-20 13:02:36 +01:00

Bugs+fragments

This commit is contained in:
Anthony Scemama 2017-01-25 16:24:02 +01:00
parent ca64c99c38
commit 27dd2420dd
4 changed files with 7 additions and 141 deletions

View File

@ -1,117 +0,0 @@
subroutine ZMQ_selection(N_in, pt2)
use f77_zmq
use selection_types
implicit none
character*(512) :: task
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer, intent(in) :: N_in
type(selection_buffer) :: b
integer :: i, N
integer, external :: omp_get_thread_num
double precision, intent(out) :: pt2(N_states)
N = max(N_in,1)
provide nproc
provide ci_electronic_energy
call new_parallel_job(zmq_to_qp_run_socket,"selection")
call zmq_put_psi(zmq_to_qp_run_socket,1,ci_electronic_energy,size(ci_electronic_energy))
call zmq_set_running(zmq_to_qp_run_socket)
call create_selection_buffer(N, N*8, b)
integer :: i_generator, i_generator_start, i_generator_max, step
! step = int(max(1.,10*elec_num/mo_tot_num)
step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
step = max(1,step)
do i= N_det_generators, 1, -step
i_generator_start = max(i-step+1,1)
i_generator_max = i
write(task,*) i_generator_start, i_generator_max, 1, N
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
end do
!$OMP PARALLEL DEFAULT(none) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) shared(ci_electronic_energy_is_built, n_det_generators_is_built, n_states_is_built, n_int_is_built, nproc_is_built)
i = omp_get_thread_num()
if (i==0) then
call selection_collector(b, pt2)
else
call selection_slave_inproc(i)
endif
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, 'selection')
do i=1,N_states
print *, 'E+PT2(', i, ') = ', ci_electronic_energy(i) + pt2(i)
enddo
if (N_in > 0) then
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN
call copy_H_apply_buffer_to_wf()
call save_wavefunction
endif
end subroutine
subroutine selection_slave_inproc(i)
implicit none
integer, intent(in) :: i
call run_selection_slave(1,i,ci_electronic_energy)
end
subroutine selection_collector(b, pt2)
use f77_zmq
use selection_types
use bitmasks
implicit none
type(selection_buffer), intent(inout) :: b
double precision, intent(out) :: pt2(N_states)
double precision :: pt2_mwen(N_states)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer(ZMQ_PTR) :: zmq_socket_pull
integer :: msg_size, rc, more
integer :: acc, i, j, robin, N, ntask
double precision, allocatable :: val(:)
integer(bit_kind), allocatable :: det(:,:,:)
integer, allocatable :: task_id(:)
integer :: done
real :: time, time0
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
zmq_socket_pull = new_zmq_pull_socket()
allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det))
done = 0
more = 1
pt2(:) = 0d0
call CPU_TIME(time0)
do while (more == 1)
call pull_selection_results(zmq_socket_pull, pt2_mwen, val(1), det(1,1,1), N, task_id, ntask)
pt2 += pt2_mwen
do i=1, N
call add_to_selection_buffer(b, det(1,1,i), val(i))
end do
do i=1, ntask
if(task_id(i) == 0) then
print *, "Error in collector"
endif
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
end do
done += ntask
call CPU_TIME(time)
! print *, "DONE" , done, time - time0
end do
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_pull_socket(zmq_socket_pull)
call sort_selection_buffer(b)
end subroutine

View File

@ -69,7 +69,7 @@ program fci_zmq
n_det_before = N_det
to_select = N_det
to_select = max(64-to_select, to_select)
to_select = max(64-N_det, to_select)
to_select = min(to_select, N_det_max-n_det_before)
call ZMQ_selection(to_select, pt2)

View File

@ -1,8 +1,8 @@
BEGIN_PROVIDER [ integer, fragment_count ]
&BEGIN_PROVIDER [ integer, fragment_first ]
fragment_count = 8
fragment_first = 4
fragment_count = 400
fragment_first = 1000
END_PROVIDER
subroutine ZMQ_pt2(pt2,relative_error)
@ -36,7 +36,7 @@ subroutine ZMQ_pt2(pt2,relative_error)
provide nproc
!call random_seed()
call random_seed()
computed = .false.
tbc(0) = first_det_of_comb - 1
@ -311,7 +311,7 @@ subroutine get_last_full_tooth(computed, last_tooth)
last_tooth = 0
combLoop : do i=comb_teeth-1, 1, -1
missing = 1
missing = 1+ (first_det_of_teeth(i+1)-first_det_of_teeth(i))/100
do j=first_det_of_teeth(i), first_det_of_teeth(i+1)-1
if(not(computed(j))) then
missing -= 1

View File

@ -337,18 +337,6 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
do s1=1,2
do i1=N_holes(s1),1,-1 ! Generate low excitations first
!if(subset /= 0 .and. mod(maskInd, 10) /= (subset-1)) then
! maskInd += 1
! cycle
!end if
maskInd += 1
if(subset == 0 .or. mod(maskInd, fragment_count) == (subset-1)) then
h1 = hole_list(i1,s1)
call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int)
@ -400,12 +388,6 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
end if
do s2=s1,2
sp = s1
@ -418,7 +400,8 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
logical :: banned(mo_tot_num, mo_tot_num,2)
logical :: bannedOrb(mo_tot_num, 2)
if(subset == 0 .or. mod(maskInd, 8) == (subset-1)) then
maskInd += 1
if(subset == 0 .or. mod(maskInd, fragment_count) == (subset-1)) then
h2 = hole_list(i2,s2)
call apply_hole(pmask, s2,h2, mask, ok, N_int)
banned = .false.