From 4a48a6b94f4021846bd03de6afb5fc13ecd5a1b6 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 25 Sep 2018 09:49:33 +0200 Subject: [PATCH] Fixed shiftedBk --- plugins/DavidsonDressed/diagonalize_CI.irp.f | 4 +--- plugins/dress_zmq/alpha_factory.irp.f | 4 ---- plugins/dress_zmq/dress_stoch_routines.irp.f | 7 +++---- plugins/dress_zmq/run_dress_slave.irp.f | 18 ++++++++++++++---- plugins/shiftedbk/selection_types.f90 | 9 --------- src/Determinants/determinants.irp.f | 2 +- src/Determinants/occ_pattern.irp.f | 11 ----------- 7 files changed, 19 insertions(+), 36 deletions(-) delete mode 100644 plugins/shiftedbk/selection_types.f90 diff --git a/plugins/DavidsonDressed/diagonalize_CI.irp.f b/plugins/DavidsonDressed/diagonalize_CI.irp.f index ddea2950..9940ee86 100644 --- a/plugins/DavidsonDressed/diagonalize_CI.irp.f +++ b/plugins/DavidsonDressed/diagonalize_CI.irp.f @@ -63,9 +63,6 @@ END_PROVIDER call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,& size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,& N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1) -! call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,& -! N_states_diag,size(CI_eigenvectors_dressed,1)) - else if (diag_algorithm == "Lapack") then @@ -159,6 +156,7 @@ subroutine diagonalize_CI_dressed ! eigenstates of the CI matrix END_DOC integer :: i,j + PROVIDE delta_ij do j=1,N_states do i=1,N_det psi_coef(i,j) = CI_eigenvectors_dressed(i,j) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index d59ab032..cdb8a905 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -81,10 +81,6 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index hole (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index)) particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index)) particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index)) - !hole (k,1) = iand(psi_det_generators(k,1,i_generator), full_ijkl_bitmask(k)) - !hole (k,2) = iand(psi_det_generators(k,2,i_generator), full_ijkl_bitmask(k)) - !particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), full_ijkl_bitmask(k)) - !particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), full_ijkl_bitmask(k)) enddo integer :: N_holes(2), N_particles(2) diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 38434224..9280b688 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -284,7 +284,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error) if (zmq_put_dvector(zmq_to_qp_run_socket,1,"state_average_weight",state_average_weight,N_states) == -1) then stop 'Unable to put state_average_weight on ZMQ server' endif - if (zmq_put_int(zmq_to_qp_run_socket,1,"dress_stoch_istate",dress_stoch_istate) == -1) then + if (zmq_put_int(zmq_to_qp_run_socket,1,'dress_stoch_istate',dress_stoch_istate) == -1) then stop 'Unable to put dress_stoch_istate on ZMQ server' endif if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) then @@ -483,9 +483,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, integer, external :: zmq_delete_tasks, dress_find_sample logical :: found integer :: worker_id + worker_id=1 zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,1) found = .false. delta = 0d0 @@ -542,7 +542,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, if(dabs(error / avg) <= relative_error) then integer, external :: zmq_put_dvector integer, external :: zmq_put_int - i= zmq_put_int(zmq_to_qp_run_socket, worker_id, "ending", (m-1)) + i= zmq_put_int(zmq_to_qp_run_socket, worker_id, 'ending', (m-1)) found = .true. end if else @@ -607,7 +607,6 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, !end do !print *, "SUM", E(1)+sum(edi(:)) !print *, "DOT", E(1)+tmp - call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) end subroutine diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index b9d73cb9..39e430a1 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -62,6 +62,7 @@ subroutine run_dress_slave(thread,iproce,energy) cp_done = 0 cp_sent = 0 will_send = 0 + cp_max(:) = 0 double precision :: hij, sij, tmp purge_task_id = 0 @@ -76,7 +77,11 @@ subroutine run_dress_slave(thread,iproce,energy) !$OMP PRIVATE(task_buf, ntask_buf,time, time0) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_push = new_zmq_push_socket(thread) - call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) + integer, external :: connect_to_taskserver + if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then + print *, irp_here, ': Unable to connect to task server' + stop -1 + endif if(worker_id == -1) then call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_push_socket(zmq_socket_push,thread) @@ -91,8 +96,8 @@ subroutine run_dress_slave(thread,iproce,energy) call push_dress_results(zmq_socket_push, 0, 0, edI_task, edI_index, breve_delta_m, task_buf, ntask_buf) end if - cp_max(:) = 0 - do while(cp_done > cp_sent .or. m /= dress_N_cp+1) + !$OMP FLUSH + do while( (cp_done > cp_sent) .or. (m /= dress_N_cp+1) ) !$OMP CRITICAL (send) if(ntask_tbd == 0) then ntask_tbd = size(task_tbd) @@ -233,7 +238,12 @@ subroutine run_dress_slave(thread,iproce,energy) end if !$OMP END SINGLE - call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) + + integer, external :: disconnect_from_taskserver + if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then + print *, irp_here, ': Unable to disconnect from task server' + stop -1 + endif call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_push_socket(zmq_socket_push,thread) !$OMP END PARALLEL diff --git a/plugins/shiftedbk/selection_types.f90 b/plugins/shiftedbk/selection_types.f90 deleted file mode 100644 index 29e48524..00000000 --- a/plugins/shiftedbk/selection_types.f90 +++ /dev/null @@ -1,9 +0,0 @@ -module selection_types - type selection_buffer - integer :: N, cur - integer(8) , pointer :: det(:,:,:) - double precision, pointer :: val(:) - double precision :: mini - endtype -end module - diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index e7ade63b..91b037ac 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -536,7 +536,7 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef) call ezfio_set_determinants_mo_label(mo_label) allocate (psi_det_save(N_int,2,ndet)) - !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k) SHARED(psi_det_save,psidet,ndet,N_int) + !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k) SHARED(psi_det_save,psidet,ndet,N_int,accu_norm) do i=1,ndet do j=1,2 do k=1,N_int diff --git a/src/Determinants/occ_pattern.irp.f b/src/Determinants/occ_pattern.irp.f index f71c2721..a6c4267a 100644 --- a/src/Determinants/occ_pattern.irp.f +++ b/src/Determinants/occ_pattern.irp.f @@ -62,17 +62,6 @@ subroutine occ_pattern_to_dets(o,d,sze,n_alpha,Nint) enddo call bitstring_to_list(o(1,1), list_todo, nt, Nint) -! nt = 0 -! ishift = 2 -! do i=1,Nint -! l = o(i,1) -! do while (l /= 0_bit_kind) -! nt = nt+1 -! list_todo(nt) = ishift+popcnt(l-1_bit_kind) - popcnt(l) -! l = iand(l,l-1_bit_kind) -! enddo -! ishift = ishift + bit_kind_size -! enddo na = 0 nd = 0