Parallelized psi_energy

ocaml/Address.ml

@@ -8,7 +8,9 @@ module Tcp : sig
 end = struct
   type t = string
   let of_string x =
-    assert (String.is_prefix ~prefix:"tcp://" x);
+    if not (String.is_prefix ~prefix:"tcp://" x) then
+      invalid_arg "Address Invalid"
+    ;
     x
   let create ~host ~port =
     assert (port > 0);

src/Davidson/davidson_parallel.irp.f

@@ -298,7 +298,8 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
 
   integer(ZMQ_PTR) :: zmq_to_qp_run_socket
   
-  if(N_st /= N_states_diag .or. sze < N_det) stop "assert fail in H_S2_u_0_nstates"
+  ASSERT (N_st == N_states_diag)
+  ASSERT (sze >= N_det) 
 
   call new_parallel_job(zmq_to_qp_run_socket,'davidson')
   

src/Davidson/diagonalization_hs2.irp.f

@@ -444,3 +444,37 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
       )
 end
 
+subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
+  use bitmasks
+  implicit none
+  BEGIN_DOC
+  ! Computes e_0 = <u_0|H|u_0>/<u_0|u_0>
+  !
+  ! n : number of determinants
+  !
+  END_DOC
+  integer, intent(in)            :: n,Nint, N_st, sze
+  double precision, intent(out)  :: e_0(N_st)
+  double precision, intent(inout) :: u_0(sze,N_st)
+  integer(bit_kind),intent(in)   :: keys_tmp(Nint,2,n)
+  
+  double precision, allocatable  :: v_0(:,:), s_0(:,:), u_1(:,:)
+  double precision               :: u_dot_u,u_dot_v,diag_H_mat_elem
+  integer                        :: i,j
+
+  if (distributed_davidson) then
+    allocate (v_0(sze,N_states_diag),s_0(sze,N_states_diag), u_1(sze,N_states_diag))
+    u_1(1:sze,1:N_states) = u_0(1:sze,1:N_states) 
+    u_1(1:sze,N_states+1:N_states_diag) = 0.d0
+    call H_S2_u_0_nstates_zmq(v_0,s_0,u_1,N_states_diag,sze)
+    deallocate(u_1)
+  else
+    allocate (v_0(sze,N_st),s_0(sze,N_st))
+    call H_S2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze)
+  endif
+  do i=1,N_st
+    e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n)
+  enddo
+  deallocate (s_0, v_0)
+end
+

src/Davidson/u0Hu0.irp.f

@@ -1,29 +1,3 @@
-subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
-  use bitmasks
-  implicit none
-  BEGIN_DOC
-  ! Computes e_0 = <u_0|H|u_0>/<u_0|u_0>
-  !
-  ! n : number of determinants
-  !
-  END_DOC
-  integer, intent(in)            :: n,Nint, N_st, sze
-  double precision, intent(out)  :: e_0(N_st)
-  double precision, intent(inout) :: u_0(sze,N_st)
-  integer(bit_kind),intent(in)   :: keys_tmp(Nint,2,n)
-  
-  double precision, allocatable  :: v_0(:,:), s_0(:,:)
-  double precision               :: u_dot_u,u_dot_v,diag_H_mat_elem
-  integer                        :: i,j
-
-  allocate (v_0(sze,N_st),s_0(sze,N_st))
-  call H_S2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze)
-  do i=1,N_st
-    e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n)
-  enddo
-  deallocate (s_0, v_0)
-end
-
 BEGIN_PROVIDER [ double precision, psi_energy, (N_states) ]
   implicit none
   BEGIN_DOC