diff --git a/plugins/dress_zmq/dress_general.irp.f b/plugins/dress_zmq/dress_general.irp.f index 0bf7e715..e31f1742 100644 --- a/plugins/dress_zmq/dress_general.irp.f +++ b/plugins/dress_zmq/dress_general.irp.f @@ -12,11 +12,10 @@ subroutine run_dressing(N_st,energy) integer :: iteration integer :: n_it_dress_max - double precision :: thresh_dress + double precision :: thresh_dress, dummy thresh_dress = thresh_dressed_ci n_it_dress_max = n_it_max_dressed_ci - if(n_it_dress_max == 1) then do j=1,N_states do i=1,N_det @@ -32,14 +31,19 @@ subroutine run_dressing(N_st,energy) delta_E = 1.d0 iteration = 0 do while (delta_E > thresh_dress) + N_det_delta_ij = N_det + touch N_det_delta_ij iteration += 1 print *, '===============================================' print *, 'Iteration', iteration, '/', n_it_dress_max print *, '===============================================' print *, '' E_old = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states)) + !print *, "DELTA IJ", delta_ij(1,1,1) + if(.true.) dummy = delta_ij_tmp(1,1,1) + if(.true.) call delta_ij_done() do i=1,N_st - call write_double(6,ci_energy_dressed(i),"Energy") + if(.true.) call write_double(6,ci_energy_dressed(i),"Energy") enddo call diagonalize_ci_dressed E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states)) @@ -55,8 +59,9 @@ subroutine run_dressing(N_st,energy) exit endif enddo - call write_double(6,ci_energy_dressed(1),"Final energy") + if(.true.) call write_double(6,ci_energy_dressed(1),"Final energy") endif - energy(1:N_st) = ci_energy_dressed(1:N_st) + + if(.true.) energy(1:N_st) = 0d0 ! ci_energy_dressed(1:N_st) end diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f index 0c15ee0b..ce89415d 100644 --- a/plugins/dress_zmq/dressing.irp.f +++ b/plugins/dress_zmq/dressing.irp.f @@ -63,8 +63,18 @@ BEGIN_PROVIDER [ double precision, dress_norm_acc, (0:N_det, N_states) ] END_PROVIDER +BEGIN_PROVIDER [ integer , N_det_delta_ij ] + implicit none + !N_det_delta_ij = 0!N_det +END_PROVIDER -BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ] +BEGIN_PROVIDER [ double precision, delta_ij, (N_states, N_det, 2) ] + implicit none + if(.true.) delta_ij(:,:N_det_delta_ij, :) = delta_ij_tmp(:,:,:) + delta_ij(:,N_det_delta_ij+1:,:) = 0d0 +END_PROVIDER + +BEGIN_PROVIDER [ double precision, delta_ij_tmp, (N_states,N_det_delta_ij,2) ] use bitmasks implicit none @@ -72,11 +82,15 @@ BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ] double precision, allocatable :: dress(:), del(:,:), del_s2(:,:) double precision :: E_CI_before(N_states), relative_error -! double precision, save :: errr = 0d0 - allocate(dress(N_states), del(N_states, N_det), del_s2(N_states, N_det)) + ! prevents re-providing if delta_ij_tmp is + ! just being copied + if(N_det_delta_ij /= N_det) return + + if(.true.) then + allocate(dress(N_states), del(N_states, N_det_delta_ij), del_s2(N_states, N_det_delta_ij)) - delta_ij = 0d0 + delta_ij_tmp = 0d0 E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion threshold_selectors = 1.d0 @@ -90,11 +104,11 @@ BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ] call write_double(6,relative_error,"Convergence of the stochastic algorithm") call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error)) - delta_ij(:,:,1) = del(:,:) - delta_ij(:,:,2) = del_s2(:,:) + delta_ij_tmp(:,:,1) = del(:,:) + delta_ij_tmp(:,:,2) = del_s2(:,:) deallocate(dress, del, del_s2) - + end if END_PROVIDER diff --git a/plugins/shiftedbk/shifted_bk_routines.irp.f b/plugins/shiftedbk/shifted_bk_routines.irp.f index 99b0fa79..98faf2ec 100644 --- a/plugins/shiftedbk/shifted_bk_routines.irp.f +++ b/plugins/shiftedbk/shifted_bk_routines.irp.f @@ -1,17 +1,56 @@ - +use selection_types BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] &BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] &BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ] &BEGIN_PROVIDER [ double precision, a_s2_i, (N_det, Nproc) ] +&BEGIN_PROVIDER [ type(selection_buffer), sb, (Nproc) ] +&BEGIN_PROVIDER [ double precision, N_det_increase_factor ] implicit none + integer :: i + integer :: n_det_add + + N_det_increase_factor = 1d0 + current_generator_(:) = 0 + do i=1,Nproc + n_det_add = max(1, int(float(N_det) * N_det_increase_factor)) + call create_selection_buffer(n_det_add, n_det_add*2, sb(i)) + end do a_h_i = 0d0 a_s2_i = 0d0 END_PROVIDER +subroutine delta_ij_done() + implicit none + integer :: i, n_det_add + + call sort_selection_buffer(sb(1)) + + do i=2,Nproc + call sort_selection_buffer(sb(i)) + call merge_selection_buffers(sb(i), sb(1)) + end do + + call sort_selection_buffer(sb(1)) + + call fill_H_apply_buffer_no_selection(sb(1)%cur,sb(1)%det,N_int,0) + call copy_H_apply_buffer_to_wf() + if (s2_eig.or.(N_states > 1) ) then + call make_s2_eigenfunction + endif + !call save_wavefunction + n_det_add = max(1, int(float(N_det) * N_det_increase_factor)) + do i=1,Nproc + call delete_selection_buffer(sb(i)) + call create_selection_buffer(n_det_add, n_det_add*2, sb(i)) + end do + !delta_ij = 0d0 +end subroutine + + subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) use bitmasks implicit none @@ -31,8 +70,8 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili double precision, external :: diag_H_mat_elem_fock integer :: i,j,k,l,m, l_sd double precision :: hdress, sdress - double precision :: de, a_h_psi(Nstates), c_alpha - + double precision :: de, a_h_psi(Nstates), c_alpha, contrib + a_h_psi = 0d0 @@ -52,13 +91,15 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili end do end do + contrib = 0d0 do i=1,Nstates de = E0_denominator(i) - haa if(DABS(de) < 1D-5) cycle c_alpha = a_h_psi(i) / de - + contrib = min(contrib, c_alpha * a_h_psi(i)) + do l_sd=1,n_minilist hdress = c_alpha * a_h_i(l_sd, iproc) sdress = c_alpha * a_s2_i(l_sd, iproc) @@ -66,6 +107,9 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili delta_ij_loc(i, minilist(l_sd), 2) += sdress end do end do + + call add_to_selection_buffer(sb(iproc), alpha, contrib) + end subroutine