Reduced RAM in pt2 slaves

2024-12-21 11:03:29 +01:00 · 2019-01-31 11:26:13 +01:00 · 2019-01-31 11:26:13 +01:00 · 9b0d38fb7b
commit 9b0d38fb7b
parent 97361aaf17
6 changed files with 33 additions and 19 deletions
--- a/src/cipsi/pt2_stoch_routines.irp.f
+++ b/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*N_in + N_in)   & ! sort/merge selection buffers
+              + 1.d0*(N_int*2.d0*ii+ ii)        & ! selection buffer
+              + 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
--- a/src/cipsi/run_pt2_slave.irp.f
+++ b/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)
-      call create_selection_buffer(N, N*2, b2)
+      bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
+      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

--- a/src/cipsi/run_selection_slave.irp.f
+++ b/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)
-        call create_selection_buffer(N, N*2, buf2)
+        bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2)
+        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

--- a/src/cipsi/selection.irp.f
+++ b/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
--- a/src/cipsi/selection_buffer.irp.f
+++ b/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
--- a/src/cipsi/slave_cipsi.irp.f
+++ b/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
-                + 1.d0*(N_int*2.d0*N_det+ N_det)  & ! sort/merge selection buffers
+                + 2.d0*(N_int*2.d0*ii+ ii)        & ! selection buffer
+                + 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