diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index ce393c27..cf7ae33c 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -318,10 +318,10 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) print '(A)', '========== ======================= ===================== ===================== ===========' - do k=1,N_states - pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate) - enddo - SOFT_TOUCH pt2_overlap + do k=1,N_states + pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate) + enddo + SOFT_TOUCH pt2_overlap enddo FREE pt2_stoch_istate @@ -575,11 +575,11 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_ endif do i=1,n_tasks if(index(i).gt.size(pt2_data_I,1).or.index(i).lt.1)then - print*,'PB !!!' - print*,'If you see this, send a bug report with the following content' - print*,irp_here - print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1) - stop -1 + print*,'PB !!!' + print*,'If you see this, send a bug report with the following content' + print*,irp_here + print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1) + stop -1 endif call pt2_add(pt2_data_I(index(i)),1.d0,pt2_data_task(i)) f(index(i)) -= 1 diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index a72d3dbb..f1001f89 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -31,12 +31,11 @@ subroutine run_pt2_slave(thread,iproc,energy) double precision, intent(in) :: energy(N_states_diag) integer, intent(in) :: thread, iproc - call run_pt2_slave_large(thread,iproc,energy) -! if (N_det > nproc*(elec_alpha_num * (mo_num-elec_alpha_num))**2) then -! call run_pt2_slave_large(thread,iproc,energy) -! else -! call run_pt2_slave_small(thread,iproc,energy) -! endif + if (N_det > 100000 ) then + call run_pt2_slave_large(thread,iproc,energy) + else + call run_pt2_slave_small(thread,iproc,energy) + endif end subroutine run_pt2_slave_small(thread,iproc,energy) @@ -67,7 +66,6 @@ subroutine run_pt2_slave_small(thread,iproc,energy) double precision, external :: memory_of_double, memory_of_int integer :: bsize ! Size of selection buffers -! logical :: sending allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max)) allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max)) @@ -85,7 +83,6 @@ subroutine run_pt2_slave_small(thread,iproc,energy) buffer_ready = .False. n_tasks = 1 -! sending = .False. done = .False. do while (.not.done) @@ -119,14 +116,13 @@ subroutine run_pt2_slave_small(thread,iproc,energy) do k=1,n_tasks call pt2_alloc(pt2_data(k),N_states) b%cur = 0 -!double precision :: time2 -!call wall_time(time2) + double precision :: time2 + call wall_time(time2) call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k))) -!call wall_time(time1) -!print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1)) + call wall_time(time1) +! print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1)) enddo call wall_time(time1) -!print *, '-->', i_generator(1), time1-time0, n_tasks integer, external :: tasks_done_to_taskserver if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then @@ -164,6 +160,11 @@ end subroutine subroutine run_pt2_slave_large(thread,iproc,energy) use selection_types use f77_zmq + BEGIN_DOC +! This subroutine can miss important determinants when the PT2 is completely +! computed. It should be called only for large workloads where the PT2 is +! interrupted before the end + END_DOC implicit none double precision, intent(in) :: energy(N_states_diag) @@ -234,30 +235,28 @@ subroutine run_pt2_slave_large(thread,iproc,energy) ASSERT (b%N == bsize) endif - double precision :: time0, time1 - call wall_time(time0) call pt2_alloc(pt2_data,N_states) b%cur = 0 call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator)) - call wall_time(time1) integer, external :: tasks_done_to_taskserver if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then done = .true. endif call sort_selection_buffer(b) - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call omp_set_lock(global_selection_buffer_lock) global_selection_buffer%mini = b%mini call merge_selection_buffers(b,global_selection_buffer) b%cur=0 call omp_unset_lock(global_selection_buffer_lock) - if ( iproc == 1 ) then + if ( iproc == 1 .or. i_generator < 100 .or. done) then call omp_set_lock(global_selection_buffer_lock) + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) global_selection_buffer%cur = 0 call omp_unset_lock(global_selection_buffer_lock) else + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif diff --git a/src/cipsi/selection_buffer.irp.f b/src/cipsi/selection_buffer.irp.f index a50b02e6..79899139 100644 --- a/src/cipsi/selection_buffer.irp.f +++ b/src/cipsi/selection_buffer.irp.f @@ -87,8 +87,8 @@ subroutine merge_selection_buffers(b1, b2) double precision :: rss double precision, external :: memory_of_double sze = max(size(b1%val), size(b2%val)) - rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze) - call check_mem(rss,irp_here) +! rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze) +! call check_mem(rss,irp_here) allocate(val(sze), detmp(N_int, 2, sze)) i1=1 i2=1 diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index 6a474662..49f1a05c 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -330,12 +330,12 @@ BEGIN_PROVIDER [ double precision, c0_weight, (N_states) ] c = maxval(psi_coef(:,i) * psi_coef(:,i)) c0_weight(i) = 1.d0/(c+1.d-20) enddo - c = 1.d0/minval(c0_weight(:)) + c = 1.d0/sum(c0_weight(:)) do i=1,N_states c0_weight(i) = c0_weight(i) * c enddo else - c0_weight = 1.d0 + c0_weight(:) = 1.d0 endif END_PROVIDER @@ -352,7 +352,7 @@ BEGIN_PROVIDER [ double precision, state_average_weight, (N_states) ] if (weight_one_e_dm == 0) then state_average_weight(:) = c0_weight(:) else if (weight_one_e_dm == 1) then - state_average_weight(:) = 1./N_states + state_average_weight(:) = 1.d0/N_states else call ezfio_has_determinants_state_average_weight(exists) if (exists) then diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index 2a6057de..b8c8658f 100644 --- a/src/determinants/determinants.irp.f +++ b/src/determinants/determinants.irp.f @@ -84,7 +84,6 @@ BEGIN_PROVIDER [ integer, psi_det_size ] else psi_det_size = 1 endif - psi_det_size = max(psi_det_size,100000) call write_int(6,psi_det_size,'Dimension of the psi arrays') endif IRP_IF MPI_DEBUG