mrcc_zmq updated for recent changes

plugins/mrcepa0/dressing.irp.f

@@ -925,7 +925,6 @@ end
   E_CI_before = mrcc_E0_denominator(1) + nuclear_repulsion
   threshold_selectors = 1.d0
   threshold_generators = 1d0 
-  !errr = errr / 2d0
   if(errr /= 0d0) then
     errr = errr / 2d0 ! (-mrcc_E0_denominator(1) + mrcc_previous_E(1)) / 1d1
   else
@@ -934,7 +933,7 @@ end
   relative_error = errr
   print *, "RELATIVE ERROR", relative_error
   call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(relative_error))
-  !errr = 
+
   mrcc_previous_E(:) = mrcc_E0_denominator(:)
   do i=N_det_non_ref,1,-1
     delta_ii_mrcc_zmq(:,1) -= delta_ij_mrcc_zmq(:, i, 1) / psi_ref_coef(1,1) * psi_non_ref_coef(i, 1)
@@ -950,7 +949,6 @@ END_PROVIDER
   use bitmasks
   implicit none
   integer                        :: i, j, i_state
-  
   !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc
   if(mrmode == 4) then
     do i = 1, N_det_ref

plugins/mrcepa0/dressing_slave.irp.f

@@ -516,7 +516,7 @@ end
   integer(ZMQ_PTR)               :: zmq_to_qp_run_socket, zmq_socket_pull
   
   integer :: KKsize = 1000000
-  
+  integer, external :: add_task_to_taskserver 
   
   call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'mrsc2')
 

plugins/mrcepa0/ezfio_interface.irp.f

@@ -1,80 +0,0 @@
-! DO NOT MODIFY BY HAND
-! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py
-! from file /home/garniron/quantum_package/src/mrcepa0/EZFIO.cfg
-
-
-BEGIN_PROVIDER [ logical, perturbative_triples  ]
-  implicit none
-  BEGIN_DOC
-! Compute perturbative contribution of the Triples
-  END_DOC
-
-  logical                        :: has
-  PROVIDE ezfio_filename
-  
-  call ezfio_has_mrcepa0_perturbative_triples(has)
-  if (has) then
-    call ezfio_get_mrcepa0_perturbative_triples(perturbative_triples)
-  else
-    print *, 'mrcepa0/perturbative_triples not found in EZFIO file'
-    stop 1
-  endif
-
-END_PROVIDER
-
-BEGIN_PROVIDER [ double precision, thresh_dressed_ci  ]
-  implicit none
-  BEGIN_DOC
-! Threshold on the convergence of the dressed CI energy
-  END_DOC
-
-  logical                        :: has
-  PROVIDE ezfio_filename
-  
-  call ezfio_has_mrcepa0_thresh_dressed_ci(has)
-  if (has) then
-    call ezfio_get_mrcepa0_thresh_dressed_ci(thresh_dressed_ci)
-  else
-    print *, 'mrcepa0/thresh_dressed_ci not found in EZFIO file'
-    stop 1
-  endif
-
-END_PROVIDER
-
-BEGIN_PROVIDER [ integer, n_it_max_dressed_ci  ]
-  implicit none
-  BEGIN_DOC
-! Maximum number of dressed CI iterations
-  END_DOC
-
-  logical                        :: has
-  PROVIDE ezfio_filename
-  
-  call ezfio_has_mrcepa0_n_it_max_dressed_ci(has)
-  if (has) then
-    call ezfio_get_mrcepa0_n_it_max_dressed_ci(n_it_max_dressed_ci)
-  else
-    print *, 'mrcepa0/n_it_max_dressed_ci not found in EZFIO file'
-    stop 1
-  endif
-
-END_PROVIDER
-
-BEGIN_PROVIDER [ integer, lambda_type  ]
-  implicit none
-  BEGIN_DOC
-! lambda type
-  END_DOC
-
-  logical                        :: has
-  PROVIDE ezfio_filename
-  
-  call ezfio_has_mrcepa0_lambda_type(has)
-  if (has) then
-    call ezfio_get_mrcepa0_lambda_type(lambda_type)
-  else
-    print *, 'mrcepa0/lambda_type not found in EZFIO file'
-    stop 1
-  endif
-
-END_PROVIDER

plugins/mrcepa0/mrcc_stoch_routines.irp.f

@@ -5,7 +5,7 @@ END_PROVIDER
 
 
 subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error)
-  use dress_types
+  !use dress_types
   use f77_zmq
   
   implicit none
@@ -24,14 +24,14 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error)
   
   double precision, external     :: omp_get_wtime
   double precision               :: time
-  double precision               :: w(N_states)
+  double precision               :: w!(N_states)
-
+  integer, external :: add_task_to_taskserver
 
 
   provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral mrcc_weight psi_selectors
 
-  w(:) = 0.d0
+  w = 0.d0
-  w(mrcc_stoch_istate) = 1.d0
+  w = 1.d0
   call update_psi_average_norm_contrib(w)
 
   
@@ -48,7 +48,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error)
   integer, external              :: zmq_put_N_det_generators
   integer, external              :: zmq_put_N_det_selectors
   integer, external              :: zmq_put_dvector
-  
+  integer, external              :: zmq_set_running 
   if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
     stop 'Unable to put psi on ZMQ server'
   endif
@@ -98,7 +98,6 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error)
           stop 'Unable to add task to task server'
         endif
   endif
-  
       if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
         print *,  irp_here, ': Failed in zmq_set_running'
       endif
@@ -107,7 +106,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error)
       !$OMP  PRIVATE(i)
   i = omp_get_thread_num()
   if (i==0) then
-    call mrcc_collector(zmq_socket_pull,E(mrcc_stoch_istate), relative_error, delta, delta_s2, mrcc)
+    call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc)
 
   else
     call mrcc_slave_inproc(i)
@@ -152,7 +151,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
   integer(ZMQ_PTR)               :: zmq_to_qp_run_socket
 
   integer(ZMQ_PTR), external     :: new_zmq_pull_socket
-  integer(ZMQ_PTR)               :: zmq_socket_pull
+  !integer(ZMQ_PTR)               :: zmq_socket_pull
 
   integer :: more
   integer :: i, j, k, i_state, N, ntask
@@ -167,6 +166,8 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
   logical, allocatable :: actually_computed(:)
   integer :: total_computed
   
+  delta = 0d0
+  delta_s2 = 0d0
   allocate(delta_det(N_states, N_det_non_ref, 0:comb_teeth+1, 2))
   allocate(cp(N_states, N_det_non_ref, N_cp, 2), mrcc_detail(N_states, N_det_generators))
   allocate(delta_loc(N_states, N_det_non_ref, 2))
@@ -191,7 +192,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
   actually_computed = .false.
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
-  zmq_socket_pull = new_zmq_pull_socket()
+  !zmq_socket_pull = new_zmq_pull_socket()
   allocate(task_id(N_det_generators), ind(1))
   more = 1
   if (time0 < 0.d0) then
@@ -225,7 +226,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
       toothMwen = tooth_of_det(ind(i))
       fracted = (toothMwen /= 0)
       if(fracted) fracted = (ind(i) == first_det_of_teeth(toothMwen))
-     
+      
       if(fracted) then
         delta_det(:,:,toothMwen-1, 1) += delta_loc(:,:,1) * (1d0-fractage(toothMwen))
         delta_det(:,:,toothMwen-1, 2) += delta_loc(:,:,2) * (1d0-fractage(toothMwen))
@@ -262,7 +263,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
 
       do i=2,N_det_generators
         if(.not. actually_computed(mrcc_jobs(i))) then
-          print *, "first not comp", i
           cur_cp = done_cp_at(i-1)
           exit
         end if
@@ -303,7 +303,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
             print *, irp_here, ': Error in sending abort signal (2)'
           endif
         endif
-
       else
         if (cur_cp > old_cur_cp) then
           old_cur_cp = cur_cp
@@ -316,7 +315,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
   end do pullLoop
  
   if(total_computed == N_det_generators) then
-    print *, "TOTALLY COMPUTED"
     delta = 0d0
     delta_s2 = 0d0
     do i=comb_teeth+1,0,-1
@@ -325,22 +323,17 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m
     end do
   else
 
-
   delta = cp(:,:,cur_cp,1)
   delta_s2 = cp(:,:,cur_cp,2)
-  
   do i=cp_first_tooth(cur_cp)-1,0,-1
     delta += delta_det(:,:,i,1)
     delta_s2 += delta_det(:,:,i,2)
   end do
 
   end if
-
   mrcc(1) = E
-  
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
-
+  !call end_zmq_pull_socket(zmq_socket_pull)
-  call end_zmq_pull_socket(zmq_socket_pull)
 end subroutine