Improved CASSD and FCI

ocaml/TaskServer.ml

@@ -389,7 +389,12 @@ let get_task msg program_state rep_socket pair_socket =
         let new_queue, task_id, task =
             Queuing_system.pop_task ~client_id program_state.queue
         in
-        if (Queuing_system.number_of_queued new_queue = 0) then
+
+        let no_task =
+          Queuing_system.number_of_queued new_queue = 0
+        in
+
+        if no_task then
           string_of_pub_state Waiting 
           |> ZMQ.Socket.send pair_socket
         else
@@ -658,12 +663,17 @@ let run ~port =
               in
 
               (** Debug input *)
+              let () = 
+                if debug_env then
+                  begin
                     Printf.sprintf "q:%d  r:%d  n:%d  : %s\n%!"
                     (Queuing_system.number_of_queued program_state.queue)
                     (Queuing_system.number_of_running program_state.queue)
                     (Queuing_system.number_of_tasks program_state.queue)
                     (Message.to_string message)
-              |> debug;
+                    |> debug
+                  end
+              in
 
               let new_program_state = 
                 try

plugins/CAS_SD_ZMQ/cassd_zmq.irp.f

@@ -1,16 +1,23 @@
-program fci_zmq
+program cassd_zmq
   implicit none
   integer                        :: i,j,k
-  logical, external              :: detEq
-  
   double precision, allocatable  :: pt2(:)
   integer                        :: degree
+  integer                        :: n_det_before, to_select
   double precision               :: threshold_davidson_in
   
   allocate (pt2(N_states))
 
   double precision               :: hf_energy_ref
   logical                        :: has
+  pt2 = -huge(1.d0)
+  threshold_davidson_in = threshold_davidson
+  threshold_davidson = threshold_davidson_in * 100.d0
+  SOFT_TOUCH threshold_davidson
+
+  call diagonalize_CI
+  call save_wavefunction
+  
   call ezfio_has_hartree_fock_energy(has)
   if (has) then
     call ezfio_get_hartree_fock_energy(hf_energy_ref)
@@ -18,15 +25,7 @@ program fci_zmq
     hf_energy_ref = ref_bitmask_energy
   endif
 
-  pt2 = 1.d0
-  threshold_davidson_in = threshold_davidson
-  threshold_davidson = threshold_davidson_in * 100.d0
-  SOFT_TOUCH threshold_davidson
-
-  
   if (N_det > N_det_max) then
-    call diagonalize_CI
-    call save_wavefunction
     psi_det = psi_det_sorted
     psi_coef = psi_coef_sorted
     N_det = N_det_max
@@ -46,13 +45,16 @@ program fci_zmq
   double precision               :: E_CI_before(N_states)
   
   
-  integer                        :: n_det_before, to_select
   print*,'Beginning the selection ...'
+  if (.True.) then ! Avoid pre-calculation of CI_energy
     E_CI_before(1:N_states) = CI_energy(1:N_states)
+  endif
+  n_det_before = 0
 
   double precision :: correlation_energy_ratio
   correlation_energy_ratio = 0.d0
 
+  if (.True.) then ! Avoid pre-calculation of CI_energy
     do while (                                                         &
           (N_det < N_det_max) .and.                                    &
           (maxval(abs(pt2(1:N_states))) > pt2_max) .and.               &
@@ -74,6 +76,7 @@ program fci_zmq
         print *,  'E               = ', CI_energy(k)
         print *,  'E(before)+PT2   = ', E_CI_before(k)+pt2(k)
       enddo
+
       print *,  '-----'
       if(N_states.gt.1)then
         print*,'Variational Energy difference'
@@ -88,12 +91,12 @@ program fci_zmq
         enddo
       endif
       E_CI_before(1:N_states) = CI_energy(1:N_states)
-    call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
+      call ezfio_set_full_ci_zmq_energy(CI_energy(1))
 
       n_det_before = N_det
-    to_select = 2*N_det
+      to_select = N_det
-    to_select = max(64-to_select, to_select)
+      to_select = max(N_det, to_select)
-    to_select = min(to_select,N_det_max-n_det_before)
+      to_select = min(to_select, N_det_max-n_det_before)
       call ZMQ_selection(to_select, pt2)
       
       PROVIDE  psi_coef
@@ -102,19 +105,18 @@ program fci_zmq
 
       if (N_det == N_det_max) then
         threshold_davidson = threshold_davidson_in
-      SOFT_TOUCH threshold_davidson
+      end if
-    endif
       call diagonalize_CI
       call save_wavefunction
       call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
     enddo
+  endif
 
   if (N_det < N_det_max) then
       threshold_davidson = threshold_davidson_in
-    SOFT_TOUCH threshold_davidson
       call diagonalize_CI
       call save_wavefunction
-    call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
+      call ezfio_set_full_ci_zmq_energy(CI_energy(1))
   endif
 
   integer :: exc_max, degree_min
@@ -148,10 +150,8 @@ program fci_zmq
       print *,  'E+PT2    = ', E_CI_before(k)+pt2(k)
       print *,  '-----'
     enddo
-    call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before+pt2)
+    call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before(1)+pt2(1))
   endif
-  call save_wavefunction
-  call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
   call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before(1)+pt2(1))
 
 end

plugins/Full_CI_ZMQ/fci_zmq.irp.f

@@ -1,8 +1,6 @@
 program fci_zmq
   implicit none
   integer                        :: i,j,k
-  logical, external              :: detEq
-  
   double precision, allocatable  :: pt2(:)
   integer                        :: degree
   integer                        :: n_det_before, to_select
@@ -12,6 +10,14 @@ program fci_zmq
 
   double precision               :: hf_energy_ref
   logical                        :: has
+  pt2 = -huge(1.d0)
+  threshold_davidson_in = threshold_davidson
+  threshold_davidson = threshold_davidson_in * 100.d0
+  SOFT_TOUCH threshold_davidson
+
+  call diagonalize_CI
+  call save_wavefunction
+  
   call ezfio_has_hartree_fock_energy(has)
   if (has) then
     call ezfio_get_hartree_fock_energy(hf_energy_ref)
@@ -19,14 +25,7 @@ program fci_zmq
     hf_energy_ref = ref_bitmask_energy
   endif
 
-  pt2 = -huge(1.d0)
-  threshold_davidson_in = threshold_davidson
-  threshold_davidson = threshold_davidson_in * 100.d0
-  SOFT_TOUCH threshold_davidson
-  
   if (N_det > N_det_max) then
-    call diagonalize_CI
-    call save_wavefunction
     psi_det = psi_det_sorted
     psi_coef = psi_coef_sorted
     N_det = N_det_max
@@ -47,12 +46,15 @@ program fci_zmq
   
   
   print*,'Beginning the selection ...'
+  if (.True.) then ! Avoid pre-calculation of CI_energy
     E_CI_before(1:N_states) = CI_energy(1:N_states)
+  endif
   n_det_before = 0
 
   double precision :: correlation_energy_ratio
   correlation_energy_ratio = 0.d0
 
+  if (.True.) then ! Avoid pre-calculation of CI_energy
     do while (                                                         &
           (N_det < N_det_max) .and.                                    &
           (maxval(abs(pt2(1:N_states))) > pt2_max) .and.               &
@@ -63,6 +65,7 @@ program fci_zmq
                       (E_CI_before(1) + pt2(1) - hf_energy_ref)
       correlation_energy_ratio = min(1.d0,correlation_energy_ratio)
 
+
       print *,  'N_det             = ', N_det
       print *,  'N_states          = ', N_states
       print*,   'correlation_ratio = ', correlation_energy_ratio
@@ -107,6 +110,7 @@ program fci_zmq
       call save_wavefunction
       call ezfio_set_full_ci_zmq_energy(CI_energy(1))
     enddo
+  endif
 
   if (N_det < N_det_max) then
       threshold_davidson = threshold_davidson_in
@@ -139,16 +143,13 @@ program fci_zmq
     print *,  'N_states = ', N_states
     do k=1,N_states
       print *, 'State', k
-      print *,  'PT2      = ', pt2
+      print *,  'PT2      = ', pt2(k)
-      print *,  'E        = ', E_CI_before
+      print *,  'E        = ', E_CI_before(k)
-      print *,  'E+PT2    = ', E_CI_before+pt2
+      print *,  'E+PT2    = ', E_CI_before(k)+pt2(k)
       print *,  '-----'
     enddo
     call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1))
   endif
-  call save_wavefunction
-  call ezfio_set_full_ci_zmq_energy(CI_energy(1))
   call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1))
+
 end
-
-

src/ZMQ/utils.irp.f

@@ -535,7 +535,7 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,name_in)
   rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0)
   message = trim(message(1:rc))
   if (message(1:2) /= 'ok') then
-    print *,  message
+    print *,  trim(message(1:rc))
     print *,  'Unable to start parallel job : '//name
     stop 1
   endif
@@ -565,6 +565,7 @@ subroutine zmq_set_running(zmq_to_qp_run_socket)
   rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0)
   message = trim(message(1:rc))
   if (message(1:2) /= 'ok') then
+    print *,  trim(message(1:rc))
     print *,  'Unable to set qp_run to Running'
     stop 1
   endif
@@ -718,6 +719,7 @@ subroutine add_task_to_taskserver(zmq_to_qp_run_socket,task)
   
   rc = f77_zmq_recv(zmq_to_qp_run_socket, message, sze-1, 0)
   if (message(1:rc) /= 'ok') then
+    print *,  trim(message(1:rc))
     print *,  trim(task)
     print *,  'Unable to add the next task'
     stop -1
@@ -762,6 +764,7 @@ subroutine add_task_to_taskserver_recv(zmq_to_qp_run_socket)
   character*(512)                :: message
   rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
   if (message(1:rc) /= 'ok') then
+    print *,  trim(message(1:rc))
     print *,  'Unable to add the next task'
     stop -1
   endif
@@ -790,6 +793,7 @@ subroutine task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_id)
   
   rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
   if (trim(message(1:rc)) /= 'ok') then
+    print *,  trim(message(1:rc))
     print *,  'Unable to send task_done message'
     stop -1
   endif