Merge branch 'master' of github.com:scemama/quantum_package

plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f

@@ -34,8 +34,6 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
 
   provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral pt2_weight psi_selectors
 
-  !call random_seed()
-  
   computed = .false.
 
   tbc(0) = first_det_of_comb - 1
@@ -72,7 +70,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
         write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, tbc(i)
         ipos += 20
         if (ipos > 63980) then
-          call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20)))
+          call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos)))
           ipos=1
           tasks = .True.
         endif
@@ -81,7 +79,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
           write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, tbc(i)
           ipos += 20
           if (ipos > 63980) then
-            call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20)))
+            call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos)))
             ipos=1
             tasks = .True.
           endif
@@ -89,7 +87,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error)
       end if
     end do
     if (ipos > 1) then
-      call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20)))
+      call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos)))
       tasks = .True.
     endif
 
@@ -237,6 +235,7 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
   
 !  print *, 'N_deterministic = ', first_det_of_teeth(1)-1
   pullLoop : do while (more == 1)
+
     call pull_pt2_results(zmq_socket_pull, Nindex, index, pt2_mwen, task_id, ntask)
     do i=1,Nindex
       pt2_detail(1:N_states, index(i)) += pt2_mwen(1:N_states,i)
@@ -259,7 +258,7 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
 
     time = omp_get_wtime()
   
-    if(time - timeLast > 3d0 .or. more /= 1) then
+    if(time - timeLast > 10d0 .or. more /= 1) then
       timeLast = time
       do i=1, first_det_of_teeth(1)-1
         if(.not.(actually_computed(i))) then
@@ -289,12 +288,12 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
       if (dabs(eqt/avg) < relative_error) then
         pt2(1) = avg
       else
-!        print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
         if (Nabove(tooth) > Nabove_old) then
           print '(G10.3, X, F16.10, G16.3,A30)', Nabove(tooth), avg+E, eqt, ''
           Nabove_old = Nabove(tooth)
         endif
       endif
+!print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
     end if
   end do pullLoop
 
@@ -332,7 +331,7 @@ end function
 
 BEGIN_PROVIDER [ integer, comb_teeth ]
   implicit none
-  comb_teeth = 100
+  comb_teeth = 200
 END_PROVIDER
 
 
@@ -544,12 +543,13 @@ end subroutine
   comb_step = 1d0/dfloat(comb_teeth)
   first_det_of_comb = 1
   do i=1,N_det_generators
-    if(pt2_weight(i)/norm_left < comb_step*.25d0) then
+    if(pt2_weight(i)/norm_left < comb_step) then
       first_det_of_comb = i
       exit
     end if
     norm_left -= pt2_weight(i)
   end do
+  call write_int(6, first_det_of_comb-1, 'Size of deterministic set')
   
   comb_step =  (1d0 - pt2_cweight(first_det_of_comb-1)) * comb_step
   

plugins/Full_CI_ZMQ/run_pt2_slave.irp.f

@@ -17,7 +17,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
   integer(ZMQ_PTR), external     :: new_zmq_push_socket
   integer(ZMQ_PTR)               :: zmq_socket_push
 
-  type(selection_buffer) :: buf, buf2
+  type(selection_buffer) :: buf
   logical :: done
 
   double precision :: pt2(N_states)
@@ -47,18 +47,12 @@ subroutine run_pt2_slave(thread,iproc,energy)
     if (done) then
       ctask = ctask - 1
     else
-      integer :: i_generator, i_i_generator, N, subset
+      integer :: i_generator, i_i_generator, subset
       read (task,*) subset, index
       
-      !!!!!
-      N=1
-      !!!!!
       if(buf%N == 0) then
         ! Only first time 
-        call create_selection_buffer(N, N*2, buf)
+        call create_selection_buffer(1, 2, buf)
-        call create_selection_buffer(N, N*3, buf2)
-      else
-        if(N /= buf%N) stop "N changed... wtf man??"
       end if
       do i_i_generator=1, Nindex
         i_generator = index
@@ -67,18 +61,13 @@ subroutine run_pt2_slave(thread,iproc,energy)
       enddo
     endif
 
-    if(done .or. ctask == size(task_id)) then
+    if(done .or. (ctask == size(task_id)) ) then
       if(buf%N == 0 .and. ctask > 0) stop "uninitialized selection_buffer"
       do i=1, ctask
          call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
       end do
       if(ctask > 0) then
         call push_pt2_results(zmq_socket_push, Nindex, index, pt2_detail, task_id(1), ctask)
-        do i=1,buf%cur
-          call add_to_selection_buffer(buf2, buf%det(1,1,i), buf%val(i))
-        enddo
-        call sort_selection_buffer(buf2)
-        buf%mini = buf2%mini
         pt2 = 0d0
         pt2_detail(:,:Nindex) = 0d0
         buf%cur = 0
@@ -92,6 +81,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
   call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   call end_zmq_push_socket(zmq_socket_push,thread)
+  call delete_selection_buffer(buf)
 end subroutine
 
 

plugins/Full_CI_ZMQ/run_selection_slave.irp.f

@@ -74,6 +74,10 @@ subroutine run_selection_slave(thread,iproc,energy)
   call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id)
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   call end_zmq_push_socket(zmq_socket_push,thread)
+  if (buf%N > 0) then
+    call delete_selection_buffer(buf)
+    call delete_selection_buffer(buf2)
+  endif
 end subroutine
 
 

plugins/Full_CI_ZMQ/zmq_selection.irp.f

@@ -93,7 +93,6 @@ subroutine selection_collector(b, N, pt2)
   double precision, pointer :: val(:)
   integer(bit_kind), pointer :: det(:,:,:)
   integer, allocatable :: task_id(:)
-  integer :: done
   real :: time, time0
   type(selection_buffer) :: b2
 
@@ -101,7 +100,6 @@ subroutine selection_collector(b, N, pt2)
   zmq_socket_pull = new_zmq_pull_socket()
   call create_selection_buffer(N, N*2, b2)
   allocate(task_id(N_det_generators))
-  done = 0
   more = 1
   pt2(:) = 0d0
   call CPU_TIME(time0)
@@ -110,25 +108,19 @@ subroutine selection_collector(b, N, pt2)
 
     pt2 += pt2_mwen
     call merge_selection_buffers(b2,b)
-!    do i=1, N
-!      call add_to_selection_buffer(b, det(1,1,i), val(i))
-!    end do
-
     do i=1, ntask
       if(task_id(i) == 0) then
           print *,  "Error in collector"
       endif
       call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
     end do
-    done += ntask
     call CPU_TIME(time)
-!    print *, "DONE" , done, time - time0
   end do
 
 
   call delete_selection_buffer(b2)
+  call sort_selection_buffer(b)
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   call end_zmq_pull_socket(zmq_socket_pull)
-  call sort_selection_buffer(b)
 end subroutine
 

src/Bitmask/bitmasks.irp.f

@@ -315,10 +315,7 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ]
 
  call ezfio_has_bitmasks_cas(exists)
  if (exists) then
-   print*,'---------------------'
-   print*,'CAS BITMASK RESTART'
    call ezfio_get_bitmasks_cas(cas_bitmask)
-   print*,'---------------------'
  else
   if(N_generators_bitmask == 1)then
    do j=1, N_cas_bitmask