From 27dd2420dd0c36d396bd3a5cf6469d9d7a1eab8a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 25 Jan 2017 16:24:02 +0100 Subject: [PATCH] Bugs+fragments --- plugins/Full_CI_ZMQ/fci_routines.irp.f | 117 ------------------- plugins/Full_CI_ZMQ/fci_zmq.irp.f | 2 +- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 8 +- plugins/Full_CI_ZMQ/selection.irp.f | 21 +--- 4 files changed, 7 insertions(+), 141 deletions(-) delete mode 100644 plugins/Full_CI_ZMQ/fci_routines.irp.f diff --git a/plugins/Full_CI_ZMQ/fci_routines.irp.f b/plugins/Full_CI_ZMQ/fci_routines.irp.f deleted file mode 100644 index 913bb0e8..00000000 --- a/plugins/Full_CI_ZMQ/fci_routines.irp.f +++ /dev/null @@ -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 - diff --git a/plugins/Full_CI_ZMQ/fci_zmq.irp.f b/plugins/Full_CI_ZMQ/fci_zmq.irp.f index f0caa44e..31d117a6 100644 --- a/plugins/Full_CI_ZMQ/fci_zmq.irp.f +++ b/plugins/Full_CI_ZMQ/fci_zmq.irp.f @@ -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) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 062709a3..7d21bb56 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -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 diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 4f8c7a40..7ca0f72f 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -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.