Merge branch 'develop' of github.com:scemama/quantum_package into develop

ocaml/GaussianPrimitive.ml

@@ -8,7 +8,7 @@ type t =
 
 let to_string p = 
   let { sym = s ; expo = e } = p in
-  Printf.sprintf "(%s, %f)" 
+  Printf.sprintf "(%s, %22e)" 
    (Symmetry.to_string s)
    (AO_expo.to_float e)
 

ocaml/Pseudo.ml

@@ -23,7 +23,7 @@ end = struct
      { expo = dz ; r_power = n }
 
   let to_string p =
-     Printf.sprintf "(%d, %f)"
+     Printf.sprintf "(%d, %22e)"
      (R_power.to_int p.r_power)
      (AO_expo.to_float p.expo)
 end
@@ -52,7 +52,7 @@ end = struct
      { expo = dz ; r_power = n ; proj = p }
 
   let to_string p =
-     Printf.sprintf "(%d, %f, %d)" 
+     Printf.sprintf "(%d, %22e, %d)" 
        (R_power.to_int p.r_power)
        (AO_expo.to_float p.expo)
        (Positive_int.to_int p.proj)

ocaml/qp_overlap_of_wf.ml

@@ -16,7 +16,8 @@ let () =
          "Syntax : %s EZFIO1 EZFIO2" Sys.argv.(0)))
   in
 
-  let fetch_wf filename =
+  let fetch_wf ~state filename =
+    (* State 0 is the ground state *)
     Ezfio.set_file filename;
     let mo_tot_num =
       Ezfio.get_mo_basis_mo_tot_num ()
@@ -28,6 +29,9 @@ let () =
     let n_det =
       Det_number.to_int d.Determinants_by_hand.n_det
     in
+    let state_shift = 
+      state*n_det
+    in
     let keys = 
       Array.map (Determinant.to_string ~mo_tot_num) 
         d.Determinants_by_hand.psi_det
@@ -40,7 +44,7 @@ let () =
     in
     for i=0 to n_det-1
     do
-      Hashtbl.add hash keys.(i) values.(i);
+      Hashtbl.add hash keys.(i) values.(state_shift+i);
     done;
     hash
   in
@@ -60,14 +64,30 @@ let () =
     result /. (sqrt (norm *. norm'))
   in
 
-  let wf, wf' = 
+  let n_st1 =
-     fetch_wf ezfio,
+      Ezfio.set_file ezfio;
-     fetch_wf ezfio'
+      Ezfio.get_determinants_n_states ()
+  and n_st2 = 
+      Ezfio.set_file ezfio';
+      Ezfio.get_determinants_n_states ()
   in
+  Array.init n_st2 (fun i -> i)
+  |> Array.iter (fun state_j -> 
+      Printf.printf "%d  " (state_j+1);
+      let wf'  = 
+           fetch_wf ~state:state_j ezfio'
+      in
+      Array.init n_st1 (fun i -> i)
+      |> Array.iter (fun state_i ->
+        let wf = 
+           fetch_wf ~state:state_i ezfio
+        in
+        let o = 
+          overlap wf wf'
+        in
+        Printf.printf "%f %!" (abs_float o)
+      );
+      Printf.printf "\n%!"
+  )
+
 
-  let o = 
-    overlap wf wf'
-  in
-  print_float (abs_float o) ;
-  print_newline ()
-  

plugins/CAS_SD_ZMQ/selection.irp.f

@@ -1251,7 +1251,10 @@ subroutine ZMQ_selection(N_in, pt2)
          stop 'Unable to add task to task server'
        endif
   endif
-  call zmq_set_running(zmq_to_qp_run_socket)
+  integer, external :: zmq_set_running
+  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+    print *,  irp_here, ': Failed in zmq_set_running'
+  endif
 
   !$OMP PARALLEL DEFAULT(shared)  SHARED(b, pt2)  PRIVATE(i) NUM_THREADS(nproc+1)
   i = omp_get_thread_num()

plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f

@@ -118,7 +118,11 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
         endif
       endif
       
-      call zmq_set_running(zmq_to_qp_run_socket)
+      integer, external :: zmq_set_running
+      if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+        print *,  irp_here, ': Failed in zmq_set_running'
+      endif
+
       
       !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1)            &
           !$OMP  PRIVATE(i)
@@ -294,7 +298,10 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_
 
       if (firstTBDcomb > Ncomb) then
         if (zmq_abort(zmq_to_qp_run_socket) == -1) then
-          stop 'Error in sending abort signal'
+          call sleep(1)
+          if (zmq_abort(zmq_to_qp_run_socket) == -1) then
+            print *, irp_here, ': Error in sending abort signal (1)'
+          endif
         endif
         exit pullLoop
       endif
@@ -322,7 +329,10 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_
         error(pt2_stoch_istate) = eqt
         print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, ''
         if (zmq_abort(zmq_to_qp_run_socket) == -1) then
-          stop 'Error in sending abort signal'
+          call sleep(1)
+          if (zmq_abort(zmq_to_qp_run_socket) == -1) then
+            print *, irp_here, ': Error in sending abort signal (2)'
+          endif
         endif
       else
         if (Nabove(tooth) > Nabove_old) then

plugins/Full_CI_ZMQ/zmq_selection.irp.f

@@ -70,7 +70,11 @@ subroutine ZMQ_selection(N_in, pt2)
   ASSERT (associated(b%det))
   ASSERT (associated(b%val))
 
-  call zmq_set_running(zmq_to_qp_run_socket)
+  integer, external :: zmq_set_running
+  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+    print *,  irp_here, ': Failed in zmq_set_running'
+  endif
+
   !$OMP PARALLEL DEFAULT(shared)  SHARED(b, pt2)  PRIVATE(i) NUM_THREADS(nproc+1)
   i = omp_get_thread_num()
   if (i==0) then

plugins/mrcepa0/dressing_slave.irp.f

@@ -208,7 +208,7 @@ subroutine mrsc2_dressing_slave(thread,iproc)
 
   deallocate(delta)
 
-  if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1)
+  if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
     continue
   endif
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)

src/Davidson/davidson_parallel.irp.f

@@ -369,8 +369,12 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   v_0 = 0.d0
   s_0 = 0.d0
 
+  integer, external :: zmq_set_running
+  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+    print *,  irp_here, ': Failed in zmq_set_running'
+  endif
+
   call omp_set_nested(.True.)
-  call zmq_set_running(zmq_to_qp_run_socket)
   !$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread)
   ithread = omp_get_thread_num()
   if (ithread == 0 ) then

src/Integrals_Bielec/ao_bi_integrals.irp.f

@@ -380,7 +380,10 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
   enddo
   deallocate(task)
   
-  call zmq_set_running(zmq_to_qp_run_socket)
+  integer, external :: zmq_set_running
+  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+    print *,  irp_here, ': Failed in zmq_set_running'
+  endif
 
   PROVIDE nproc
   !$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)

src/Integrals_Bielec/mo_bi_integrals.irp.f

@@ -122,7 +122,7 @@ BEGIN_PROVIDER [ logical, mo_bielec_integrals_in_map ]
      call four_index_transform_block(ao_integrals_map,mo_integrals_map, &
          mo_coef, size(mo_coef,1),                                      &
          1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num,                    &
-         1, 1, 1, 1, mo_tot_num, mo_tot_num, mo_tot_num, mo_tot_num)
+         1, 1, 1, 1, mo_num, mo_num, mo_num, mo_num)
 !
 !     call four_index_transform(ao_integrals_map,mo_integrals_map, &
 !         mo_coef, size(mo_coef,1),                                      &

src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f

@@ -105,6 +105,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num,ao_num)]
                 pseudo_n_k_transp (1,k), & 
                 pseudo_dz_k_transp(1,k), & 
                 A_center,power_A,alpha,B_center,power_B,beta,C_center)
+
+!if ((k==nucl_num).and.(num_A == nucl_num).and.(num_B == nucl_num)) then
+!print *,  pseudo_klocmax,pseudo_v_k_transp (1,k),pseudo_n_k_transp (1,k),pseudo_dz_k_transp(1,k)
+!print *,  A_center(1:3), power_A
+!print *,  B_center(1:3), power_B
+!print *,  C_center(1:3)
+!print *,  c
+!endif
           enddo
           ao_pseudo_integral_local(i,j) = ao_pseudo_integral_local(i,j) +&
               ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i)*c

src/MO_Basis/mos.irp.f

@@ -35,6 +35,24 @@ BEGIN_PROVIDER [ integer, mo_tot_num ]
   
 END_PROVIDER
 
+BEGIN_PROVIDER [ integer, mo_num ]
+ implicit none
+ BEGIN_DOC
+ ! mo_tot_num without the highest deleted MOs
+ END_DOC
+ mo_num = mo_tot_num
+ integer :: i
+ mo_num = mo_tot_num
+ do i=mo_tot_num,1,-1
+   if (mo_class(i) == 'Deleted') then
+     mo_num -= 1
+   else
+     exit
+   endif
+ enddo
+END_PROVIDER
+
+
 
 BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_tot_num) ]
   implicit none

src/ZMQ/utils.irp.f

@@ -148,12 +148,12 @@ function new_zmq_to_qp_run_socket()
      stop 'Unable to create zmq req socket'
   endif
 
-  rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 10000, 4)
+  rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 30000, 4)
   if (rc /= 0) then
     stop 'Unable to set send timeout in new_zmq_to_qp_run_socket'
   endif
 
-  rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 10000, 4)
+  rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 30000, 4)
   if (rc /= 0) then
     stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket'
   endif
@@ -347,12 +347,12 @@ IRP_ENDIF
 !    stop 'Unable to set ZMQ_SNDBUF on push socket'
 !  endif
 
-  rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,0,4)
+  rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,1,4)
   if (rc /= 0) then
     stop 'Unable to set ZMQ_IMMEDIATE on push socket'
   endif
   
-  rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 10000, 4)
+  rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 30000, 4)
   if (rc /= 0) then
     stop 'Unable to set send timout in new_zmq_push_socket'
   endif
@@ -565,7 +565,7 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
   
 end
 
-subroutine zmq_set_running(zmq_to_qp_run_socket)
+integer function zmq_set_running(zmq_to_qp_run_socket)
   use f77_zmq
   implicit none
   BEGIN_DOC
@@ -576,22 +576,21 @@ subroutine zmq_set_running(zmq_to_qp_run_socket)
   character*(512)                :: message
   integer                        :: rc, sze
 
+  zmq_set_running = 0
   message = 'set_running'
   sze = len(trim(message))
   rc = f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)
   if (rc /= sze) then
-    print *,  irp_here, ':f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)'
+    zmq_set_running = -1
-    stop 'error'
+    return
   endif
   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))
+    zmq_set_running = -1
-    print *,  'Unable to set qp_run to Running'
+    return
-    stop 1
   endif
-  
+
-  
 end
 
 
@@ -616,11 +615,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
     stop 'Wrong end of job'
   endif
 
-  do i=6,1,-1
+  do i=10,1,-1
     rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job '//trim(zmq_state),8+len(trim(zmq_state)),0)
     rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0)
     if (trim(message(1:13)) == 'error waiting') then
-      print *,  trim(message(1:rc))
       call sleep(1)
       cycle
     else if (message(1:2) == 'ok') then