Reduced RAM in pt2 slaves

src/cipsi/pt2_stoch_routines.irp.f

@@ -248,8 +248,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
               + 64.d0*pt2_n_tasks_max           & ! task
               + 3.d0*pt2_n_tasks_max*N_states   & ! pt2, variance, norm
               + 1.d0*pt2_n_tasks_max            & ! i_generator, subset
-              + 2.d0*(N_int*2.d0*N_in + N_in)   & ! selection buffers
+              + 1.d0*(N_int*2.d0*ii+ ii)        & ! selection buffer
-              + 1.d0*(N_int*2.d0*N_in + N_in)   & ! sort/merge selection buffers
+              + 1.d0*(N_int*2.d0*ii+ ii)        & ! sort selection buffer
               + 2.0d0*(ii)                      & ! preinteresting, interesting,
                                                   ! prefullinteresting, fullinteresting
               + 2.0d0*(N_int*2*ii)              & ! minilist, fullminilist
@@ -422,6 +422,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
   stop_now = .false.
   do while (n <= N_det_generators)
     if(f(pt2_J(n)) == 0) then
+!print *,  'f(pt2_J(n)) == 0'
       d(pt2_J(n)) = .true.
       do while(d(U+1))
         U += 1
@@ -447,6 +448,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
       ! Add Stochastic part
       c = pt2_R(n)
       if(c > 0) then
+!print *,  'c>0'
         x  = 0d0
         x2 = 0d0
         x3 = 0d0
@@ -497,8 +499,10 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
       end if
       n += 1
     else if(more == 0) then
+!print *,  'more == 0'
       exit
     else
+!print *,  'pulling...'
       call pull_pt2_results(zmq_socket_pull, index, eI_task, vI_task, nI_task, task_id, n_tasks, b2)
       if (zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n_tasks,more) == -1) then
           stop 'Unable to delete tasks'
@@ -513,10 +517,14 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error, varianc
         call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
         if (b2%val(i) > b%mini) exit
       end do
+!print *,  'done pulling'
     end if
   end do
+!print *,  'deleting b2'
   call delete_selection_buffer(b2)
+!print *,  'sorting b'
   call sort_selection_buffer(b)
+!print *,  'done'
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
 
 end subroutine

src/cipsi/run_pt2_slave.irp.f

@@ -18,7 +18,8 @@ subroutine run_pt2_slave(thread,iproc,energy)
   integer(ZMQ_PTR), external     :: new_zmq_push_socket
   integer(ZMQ_PTR)               :: zmq_socket_push
 
-  type(selection_buffer) :: b, b2
+  type(selection_buffer) :: b
+!  type(selection_buffer) :: b2
   logical :: done, buffer_ready
 
   double precision,allocatable :: pt2(:,:), variance(:,:), norm(:,:)
@@ -27,6 +28,8 @@ subroutine run_pt2_slave(thread,iproc,energy)
 
   double precision :: rss
   double precision, external :: memory_of_double, memory_of_int
+  integer :: bsize ! Size of selection buffers
+
   rss  = memory_of_int(pt2_n_tasks_max)*67.d0
   rss += memory_of_double(pt2_n_tasks_max)*(N_states*3)
   call check_mem(rss,irp_here)
@@ -72,8 +75,9 @@ subroutine run_pt2_slave(thread,iproc,energy)
     enddo
     if (b%N == 0) then
       ! Only first time
-      call create_selection_buffer(N, N*2, b)
+      bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
-      call create_selection_buffer(N, N*2, b2)
+      call create_selection_buffer(bsize, bsize*2, b)
+!      call create_selection_buffer(N, N*2, b2)
       buffer_ready = .True.
     else
       ASSERT (N == b%N)
@@ -100,9 +104,9 @@ subroutine run_pt2_slave(thread,iproc,energy)
       done = .true.
     endif
     call sort_selection_buffer(b)
-    call merge_selection_buffers(b,b2)
+!    call merge_selection_buffers(b,b2)
     call push_pt2_results(zmq_socket_push, i_generator, pt2, variance, norm, b, task_id, n_tasks)
-    b%mini = b2%mini
+!    b%mini = b2%mini
     b%cur=0
 
     ! Try to adjust n_tasks around nproc/8 seconds per job
@@ -120,7 +124,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   if (buffer_ready) then
     call delete_selection_buffer(b)
-    call delete_selection_buffer(b2)
+!    call delete_selection_buffer(b2)
   endif
 end subroutine
 

src/cipsi/run_selection_slave.irp.f

@@ -55,12 +55,13 @@ subroutine run_selection_slave(thread,iproc,energy)
     if (done) then
       ctask = ctask - 1
     else
-      integer :: i_generator, N, subset
+      integer :: i_generator, N, subset, bsize
       read(task,*) subset, i_generator, N
       if(buf%N == 0) then
         ! Only first time
-        call create_selection_buffer(N, N*2, buf)
+        bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
-        call create_selection_buffer(N, N*2, buf2)
+        call create_selection_buffer(bsize, bsize*2, buf)
+!        call create_selection_buffer(N, N*2, buf2)
         buffer_ready = .True.
       else
         ASSERT (N == buf%N)
@@ -83,9 +84,9 @@ subroutine run_selection_slave(thread,iproc,energy)
       end do
       if(ctask > 0) then
         call sort_selection_buffer(buf)
-        call merge_selection_buffers(buf,buf2)
+!        call merge_selection_buffers(buf,buf2)
         call push_selection_results(zmq_socket_push, pt2, variance, norm, buf, task_id(1), ctask)
-        buf%mini = buf2%mini
+!        buf%mini = buf2%mini
         pt2(:) = 0d0
         variance(:) = 0d0
         norm(:) = 0d0
@@ -108,7 +109,7 @@ subroutine run_selection_slave(thread,iproc,energy)
   call end_zmq_push_socket(zmq_socket_push,thread)
   if (buffer_ready) then
     call delete_selection_buffer(buf)
-    call delete_selection_buffer(buf2)
+!    call delete_selection_buffer(buf2)
   endif
 end subroutine
 

src/cipsi/selection.irp.f

@@ -153,9 +153,6 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
   logical :: monoAdo, monoBdo
   integer :: maskInd
 
-  double precision :: rss
-  double precision, external :: memory_of_double, memory_of_int
-
   PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
   PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
   PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns

src/cipsi/selection_buffer.irp.f

@@ -2,6 +2,10 @@
 subroutine create_selection_buffer(N, siz_, res)
   use selection_types
   implicit none
+  BEGIN_DOC
+! Allocates the memory for a selection buffer.
+! The arrays have dimension siz_ and the maximum number of elements is N
+  END_DOC
 
   integer, intent(in) :: N, siz_
   type(selection_buffer), intent(out) :: res

src/cipsi/slave_cipsi.irp.f

@@ -251,8 +251,8 @@ subroutine run_slave_main
                 + 64.d0*pt2_n_tasks_max           & ! task
                 + 3.d0*pt2_n_tasks_max*N_states   & ! pt2, variance, norm
                 + 1.d0*pt2_n_tasks_max            & ! i_generator, subset
-                + 2.d0*(N_int*2.d0*N_det+ N_det)  & ! selection buffers
+                + 2.d0*(N_int*2.d0*ii+ ii)        & ! selection buffer
-                + 1.d0*(N_int*2.d0*N_det+ N_det)  & ! sort/merge selection buffers
+                + 1.d0*(N_int*2.d0*ii+ ii)        & ! sort selection buffer
                 + 2.0d0*(ii)                      & ! preinteresting, interesting,
                                                     ! prefullinteresting, fullinteresting
                 + 2.0d0*(N_int*2*ii)              & ! minilist, fullminilist