From 3044e7e72a1f35a909052594e69569b828b3ded9 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 23 May 2018 13:13:30 +0200 Subject: [PATCH] removed limit to deterministic set size --- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 2 +- plugins/Generators_full/generators.irp.f | 2 +- plugins/dress_zmq/dress_stoch_routines.irp.f | 11 ++++++----- plugins/dress_zmq/dressing.irp.f | 2 +- plugins/shiftedbk/selection_buffer.irp.f | 19 +++++++++++++++++++ plugins/shiftedbk/shifted_bk_routines.irp.f | 20 ++++++++++++-------- 6 files changed, 40 insertions(+), 16 deletions(-) diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index d3f7486f..73d71365 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -323,7 +323,7 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_ eqt = 0.d0 endif call wall_time(time) - if ( (dabs(eqt/avg) < relative_error) .or. (dabs(eqt) < absolute_error) .and. Nabove(tooth) >= 30) then + if ( ((dabs(eqt/avg) < relative_error) .or. (dabs(eqt) < absolute_error)) .and. Nabove(tooth) >= 30) then ! Termination pt2(pt2_stoch_istate) = avg error(pt2_stoch_istate) = eqt diff --git a/plugins/Generators_full/generators.irp.f b/plugins/Generators_full/generators.irp.f index 4f2c715e..98d49069 100644 --- a/plugins/Generators_full/generators.irp.f +++ b/plugins/Generators_full/generators.irp.f @@ -13,7 +13,7 @@ BEGIN_PROVIDER [ integer, N_det_generators ] N_det_generators = N_det do i=1,N_det norm = norm + psi_average_norm_contrib_sorted(i) - if (norm >= threshold_generators) then + if (norm > threshold_generators+1d-10) then N_det_generators = i exit endif diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index cb43baad..8844e064 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -227,6 +227,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, pullLoop : do while (loop) call pull_dress_results(zmq_socket_pull, ind, cur_cp, delta_loc, int_buf, double_buf, det_buf, N_buf, task_id, dress_mwen) + !print *, cur_cp, ind if(floop) then call wall_time(time) print *, "first_pull", time-time0 @@ -375,7 +376,7 @@ END_PROVIDER integer, allocatable :: filler(:) integer :: nfiller, lfiller, cfiller logical :: fracted - + integer :: first_suspect provide psi_coef_generators first_suspect = 1 @@ -436,7 +437,7 @@ END_PROVIDER end if !!!!!!!!!!!!!!!!!!!!!!!! - if(.FALSE.) then + if(.TRUE.) then do l=first_suspect,N_det_generators if((.not. computed(l))) then N_dress_jobs+=1 @@ -620,7 +621,6 @@ subroutine add_comb(com, computed, cp, N, tbc) !DIR$ FORCEINLINE call get_comb(com, dets) - k=N+1 do i = 1, comb_teeth l = dets(i) @@ -681,10 +681,11 @@ END_PROVIDER norm_left = 1d0 comb_step = 1d0/dfloat(comb_teeth) + !print *, "comb_step", comb_step first_det_of_comb = 1 - do i=1,min(100,N_det_generators) + do i=1,N_det_generators ! min(100,N_det_generators) + first_det_of_comb = i if(dress_weight(i)/norm_left < comb_step) then - first_det_of_comb = i exit end if norm_left -= dress_weight(i) diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f index a25aaf2f..0e95ef56 100644 --- a/plugins/dress_zmq/dressing.irp.f +++ b/plugins/dress_zmq/dressing.irp.f @@ -100,7 +100,7 @@ BEGIN_PROVIDER [ double precision, delta_ij_tmp, (N_states,N_det_delta_ij,2) ] ! else ! errr = 1d-4 ! end if - relative_error = 5.d-5 + relative_error = 0d0 ! 5.d-5 call write_double(6,relative_error,"Convergence of the stochastic algorithm") diff --git a/plugins/shiftedbk/selection_buffer.irp.f b/plugins/shiftedbk/selection_buffer.irp.f index 17410b7b..8c3bee91 100644 --- a/plugins/shiftedbk/selection_buffer.irp.f +++ b/plugins/shiftedbk/selection_buffer.irp.f @@ -137,3 +137,22 @@ subroutine sort_selection_buffer(b) b%cur = nmwen end subroutine + + +subroutine truncate_to_mini(b) + use selection_types + implicit none + + type(selection_buffer), intent(inout) :: b + + do + if(b%cur == 0) exit + if(b%val(b%cur) <= b%mini) exit + b%cur -= 1 + end do +end subroutine + + + + + diff --git a/plugins/shiftedbk/shifted_bk_routines.irp.f b/plugins/shiftedbk/shifted_bk_routines.irp.f index 30153dbc..c2775ab2 100644 --- a/plugins/shiftedbk/shifted_bk_routines.irp.f +++ b/plugins/shiftedbk/shifted_bk_routines.irp.f @@ -52,22 +52,26 @@ subroutine generator_done(i_gen, int_buf, double_buf, det_buf, N_buf, iproc) integer :: i call sort_selection_buffer(sb(iproc)) - det_buf(:,:,:sb(iproc)%cur) = sb(iproc)%det(:,:,:sb(iproc)%cur) - double_buf(:sb(iproc)%cur) = sb(iproc)%val(:sb(iproc)%cur) - double_buf(sb(iproc)%cur+1:sb(iproc)%cur+N_states) = slave_sum_alpha2(:,iproc) - N_buf(1) = 1 - N_buf(2) = sb(iproc)%cur+N_states - N_buf(3) = sb(iproc)%cur - + if(sb(iproc)%cur > 0) then !$OMP CRITICAL call merge_selection_buffers(sb(iproc), mini_sb) !call sort_selection_buffer(mini_sb) do i=1,Nproc - sb(i)%mini = min(sb(i)%mini, mini_sb%mini) + mini_sb%mini = min(sb(i)%mini, mini_sb%mini) + end do + do i=1,Nproc + sb(i)%mini = mini_sb%mini end do !$OMP END CRITICAL end if + call truncate_to_mini(sb(iproc)) + det_buf(:,:,:sb(iproc)%cur) = sb(iproc)%det(:,:,:sb(iproc)%cur) + double_buf(:sb(iproc)%cur) = sb(iproc)%val(:sb(iproc)%cur) + double_buf(sb(iproc)%cur+1:sb(iproc)%cur+N_states) = slave_sum_alpha2(:,iproc) + N_buf(1) = 1 + N_buf(2) = sb(iproc)%cur+N_states + N_buf(3) = sb(iproc)%cur sb(iproc)%cur = 0 slave_sum_alpha2(:,iproc) = 0d0