parallel bug

plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f

@@ -233,7 +233,6 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, absolute_error, pt2
       end do
     end if
   end do
-  
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
 end subroutine
 

plugins/dress_zmq/dress_stoch_routines.irp.f

@@ -27,22 +27,10 @@ BEGIN_PROVIDER [ integer, dress_N_cp_max ]
   dress_N_cp_max = 100
 END_PROVIDER
 
-BEGIN_PROVIDER[ integer, dress_M_m, (dress_N_cp_max)]
-  implicit none
-  integer :: i
-  
-  do i=1,dress_N_cp_max-1
-    dress_M_m(i) = N_det_generators * i / (dress_N_cp_max+1)
-  end do
-  dress_M_m(1) = 1
-  dress_M_m(dress_N_cp_max) = N_det_generators+1
-END_PROVIDER
 
-
-
- BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
+ BEGIN_PROVIDER[ integer, dress_M_m, (dress_N_cp_max)]
+&BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
 &BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)]
-&BEGIN_PROVIDER[ integer, dress_R, (0:N_det_generators)]
 &BEGIN_PROVIDER[ integer, dress_R1, (0:N_det_generators)]
 &BEGIN_PROVIDER[ double precision, dress_M_mi, (dress_N_cp_max, N_det_generators+1)]
 &BEGIN_PROVIDER [ integer, dress_P, (N_det_generators) ]
@@ -59,12 +47,17 @@ END_PROVIDER
   
   dress_M_mi = 0d0
   tilde_M = 0d0
-  dress_R(:) = 0
   dress_R1(:) = 0
   N_c = 0
   N_j = pt2_n_0(1)
   d(:) = .false.
 
+  do i=1,dress_N_cp_max-1
+    dress_M_m(i) = N_det_generators * i / (dress_N_cp_max+1)
+  end do
+  dress_M_m(1) = 1
+  dress_M_m(dress_N_cp_max) = N_det_generators+1
+
   do i=1,N_j
       d(i) = .true.
       pt2_J(i) = i
@@ -103,7 +96,6 @@ END_PROVIDER
     
     if(N_c == dress_M_m(m)) then
       dress_R1(m) = N_j
-      dress_R(N_j) = N_c
       dress_M_mi(m, :N_det_generators) = tilde_M(:)
       m += 1
     end if
@@ -111,7 +103,7 @@ END_PROVIDER
   
   dress_N_cp = m-1
   dress_R1(dress_N_cp) = N_j
-  
+  dress_M_m(dress_N_cp) = N_c
   !!!!!!!!!!!!!!
   do m=1,dress_N_cp
     do i=dress_R1(m-1)+1, dress_R1(m)
@@ -263,6 +255,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
     !!$OMP END PARALLEL
     delta_out(dress_stoch_istate,1:N_det) = delta(dress_stoch_istate,1:N_det)
     delta_s2_out(dress_stoch_istate,1:N_det) = delta_s2(dress_stoch_istate,1:N_det)
+    
     call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress')
     
     print *, '========== ================= ================= ================='
@@ -401,25 +394,23 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
           S2(p) += x**2
         end do
       end do
-        t = dress_dot_t(m)
-        avg = S(t) / dble(c)
-        eqt = (S2(t) / c) - (S(t)/c)**2
-        eqt = sqrt(eqt / dble(c-1))
-        error = eqt
-        time = omp_get_wtime()
-        print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0+E(dress_stoch_istate), eqt, time-time0, ''
-        m += 1
-        if(eqt <= relative_error) then
-          print *, "ABORT"
+      t = dress_dot_t(m)
+      avg = S(t) / dble(c)
+      eqt = (S2(t) / c) - (S(t)/c)**2
+      eqt = sqrt(eqt / dble(c-1))
+      error = eqt
+      time = omp_get_wtime()
+      print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0, eqt, time-time0, ''
+      m += 1
+      if(eqt <= 0d0*relative_error) then
+        if (zmq_abort(zmq_to_qp_run_socket) == -1) then
+          call sleep(1)
           if (zmq_abort(zmq_to_qp_run_socket) == -1) then
-            call sleep(1)
-            if (zmq_abort(zmq_to_qp_run_socket) == -1) then
-              print *, irp_here, ': Error in sending abort signal (2)'
-            endif
+            print *, irp_here, ': Error in sending abort signal (2)'
           endif
-        end if
+        endif
+      end if
     else
-      task_id = 0
       do
         call  pull_dress_results(zmq_socket_pull, m_task, f, edI_task, edI_index, breve_delta_m, task_id, n_tasks)
         if(task_id == 0) exit

plugins/dress_zmq/run_dress_slave.irp.f

@@ -46,7 +46,7 @@ subroutine run_dress_slave(thread,iproce,energy)
 
   edI = 0d0
   f = 0
-  delta_det = 0d9
+  delta_det = 0d0
   cp = 0d0
 
   task(:) = CHAR(0)
@@ -64,14 +64,13 @@ subroutine run_dress_slave(thread,iproce,energy)
   will_send = 0
 
   double precision :: hij, sij, tmp
-  !call i_h_j_s2(psi_det(1,1,1),psi_det(1,1,2),N_int,hij, sij)
   
   hij = E0_denominator(1)  !PROVIDE BEFORE OMP PARALLEL
 
   !$OMP PARALLEL DEFAULT(SHARED) &
   !$OMP PRIVATE(breve_delta_m, task, task_id) &
-  !$OMP PRIVATE(fac,m) &
-  !$OMP PRIVATE(i, will_send, i_generator, subset, iproc) &
+  !$OMP PRIVATE(tmp,fac,m,l,t,sum_f,n_tasks) &
+  !$OMP PRIVATE(i,p,will_send, i_generator, subset, iproc) &
   !$OMP PRIVATE(zmq_to_qp_run_socket, zmq_socket_push, worker_id)
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
@@ -117,15 +116,13 @@ subroutine run_dress_slave(thread,iproce,energy)
         breve_delta_m(:,:,2) += cp(:,:,l,2)
       end do
 
-      breve_delta_m(:,:,:) = breve_delta_m(:,:,:) / dress_M_m(will_send) !/ cps_N(cur_cp)
+      breve_delta_m(:,:,:) = breve_delta_m(:,:,:) / dress_M_m(will_send)
       
       do t=dress_dot_t(will_send)-1,0,-1
         breve_delta_m(:,:,1) = breve_delta_m(:,:,1) + delta_det(:,:,t,1)
         breve_delta_m(:,:,2) = breve_delta_m(:,:,2) + delta_det(:,:,t,2)
       end do
       
-      
-      
       call omp_set_lock(sending)
       n_tasks = 0
       sum_f = 0
@@ -137,7 +134,6 @@ subroutine run_dress_slave(thread,iproce,energy)
           sum_f += f(i)
         end if
       end do
-!!!!call  pull_dress_results(zmq_socket_pull, m_task, f, edI_task, edI_index, breve_delta_m, task_id, n_tasks)
       call push_dress_results(zmq_socket_push, will_send, sum_f, edI_task, edI_index, breve_delta_m, 0, n_tasks)
       call omp_unset_lock(sending)
     end if
@@ -145,11 +141,9 @@ subroutine run_dress_slave(thread,iproce,energy)
     if(m /= dress_N_cp+1) then    
       !UPDATE i_generator
 
-
       breve_delta_m(:,:,:) = 0d0
       call generator_start(i_generator, iproc)
 
-
       call alpha_callback(breve_delta_m, i_generator, subset, pt2_F(i_generator)*0 + 1, iproc)
       
       t = dress_T(i_generator)
@@ -159,9 +153,9 @@ subroutine run_dress_slave(thread,iproce,energy)
       delta_det(:,:,t, 2) += breve_delta_m(:,:,2)
       call omp_unset_lock(lck_det(t))
     
-      do p=1,dress_N_cp ! m, dress_N_cp
-        if(dress_e(i_generator, p) /= 0) then
-          fac = dress_e(i_generator, p) * pt2_W_T / pt2_w(i_generator)
+      do p=1,dress_N_cp
+        if(dress_e(i_generator, p) /= 0d0) then
+          fac = dress_e(i_generator, p)
           call omp_set_lock(lck_sto(p))
           cp(:,:,p,1) += breve_delta_m(:,:,1) * fac
           cp(:,:,p,2) += breve_delta_m(:,:,2) * fac
@@ -170,11 +164,11 @@ subroutine run_dress_slave(thread,iproce,energy)
       end do
       
       tmp = 0d0
-      do i=1,N_det
+      do i=N_det,1,-1
         tmp += psi_coef(i, dress_stoch_istate)*breve_delta_m(dress_stoch_istate, i, 1)
       end do
       !$OMP ATOMIC
-      edI(i_generator) += tmp!  dot_product(psi_det_coef(:, dress_stoch_istate), breve_delta_m(dress_stoch_istate, :, 1))
+      edI(i_generator) += tmp
       !$OMP ATOMIC
       f(i_generator) += 1
       !push bidon