diff --git a/ocaml/Address.ml b/ocaml/Address.ml index 47eb3fd6..c819a463 100644 --- a/ocaml/Address.ml +++ b/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); diff --git a/src/Davidson/davidson_parallel.irp.f b/src/Davidson/davidson_parallel.irp.f index a0902ec2..9bca4b14 100644 --- a/src/Davidson/davidson_parallel.irp.f +++ b/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') diff --git a/src/Davidson/diagonalization_hs2.irp.f b/src/Davidson/diagonalization_hs2.irp.f index 54672609..b0869bf8 100644 --- a/src/Davidson/diagonalization_hs2.irp.f +++ b/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 = / + ! + ! 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 + diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index d29b39f1..38576cd1 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/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 = / - ! - ! 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