mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Merge branch 'master' of github.com:scemama/quantum_package
This commit is contained in:
commit
4b525172bc
@ -42,7 +42,7 @@ end = struct
|
|||||||
assert (String.is_prefix ~prefix:"inproc://" x);
|
assert (String.is_prefix ~prefix:"inproc://" x);
|
||||||
x
|
x
|
||||||
let create name =
|
let create name =
|
||||||
Printf.sprintf "ipc://%s" name
|
Printf.sprintf "inproc://%s" name
|
||||||
let to_string x = x
|
let to_string x = x
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -134,7 +134,7 @@ subroutine ZMQ_selection(N_in, pt2)
|
|||||||
|
|
||||||
step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
|
step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
|
||||||
step = max(1,step)
|
step = max(1,step)
|
||||||
do i= 1,N_det_generators, step
|
do i= N_det_generators, 1, -step
|
||||||
i_generator_start = max(i-step+1,1)
|
i_generator_start = max(i-step+1,1)
|
||||||
i_generator_max = i
|
i_generator_max = i
|
||||||
write(task,*) i_generator_start, i_generator_max, 1, N
|
write(task,*) i_generator_start, i_generator_max, 1, N
|
||||||
|
@ -271,7 +271,7 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge
|
|||||||
!delta_ii_(i_state,i_I) = 0.d0
|
!delta_ii_(i_state,i_I) = 0.d0
|
||||||
do l_sd=1,idx_alpha(0)
|
do l_sd=1,idx_alpha(0)
|
||||||
k_sd = idx_alpha(l_sd)
|
k_sd = idx_alpha(l_sd)
|
||||||
delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd)
|
delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + 0.5d0 * dIa_hla(i_state,k_sd)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
|
@ -901,11 +901,11 @@ END_PROVIDER
|
|||||||
endif
|
endif
|
||||||
resold = res
|
resold = res
|
||||||
|
|
||||||
if(mod(k, 5) == 0) then
|
if(mod(k, 100) == 0) then
|
||||||
print *, "res ", k, res
|
print *, "res ", k, res
|
||||||
end if
|
end if
|
||||||
|
|
||||||
if(res < 1d-12) exit
|
if(res < 1d-9) exit
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
|
||||||
@ -923,7 +923,119 @@ END_PROVIDER
|
|||||||
|
|
||||||
print *, k, "res : ", res, "norm : ", sqrt(norm)
|
print *, k, "res : ", res, "norm : ", sqrt(norm)
|
||||||
|
|
||||||
!dIj_unique(:size(X), s) = X(:)
|
!---------------
|
||||||
|
! double precision :: e_0, overlap
|
||||||
|
! double precision, allocatable :: u_0(:)
|
||||||
|
! integer(bit_kind), allocatable :: keys_tmp(:,:,:)
|
||||||
|
! allocate (u_0(N_det), keys_tmp(N_int,2,N_det) )
|
||||||
|
! k=0
|
||||||
|
! overlap = 0.d0
|
||||||
|
! do i=1,N_det_ref
|
||||||
|
! k = k+1
|
||||||
|
! u_0(k) = psi_ref_coef(i,1)
|
||||||
|
! keys_tmp(:,:,k) = psi_ref(:,:,i)
|
||||||
|
! overlap += u_0(k)*psi_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
! norm = 0.d0
|
||||||
|
! do i=1,N_det_non_ref
|
||||||
|
! k = k+1
|
||||||
|
! u_0(k) = psi_non_ref_coef(i,1)
|
||||||
|
! keys_tmp(:,:,k) = psi_non_ref(:,:,i)
|
||||||
|
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||||
|
! print *, 'Energy of |Psi_CASSD> : ', e_0 + nuclear_repulsion, overlap
|
||||||
|
!
|
||||||
|
! k=0
|
||||||
|
! overlap = 0.d0
|
||||||
|
! do i=1,N_det_ref
|
||||||
|
! k = k+1
|
||||||
|
! u_0(k) = psi_ref_coef(i,1)
|
||||||
|
! keys_tmp(:,:,k) = psi_ref(:,:,i)
|
||||||
|
! overlap += u_0(k)*psi_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
! norm = 0.d0
|
||||||
|
! do i=1,N_det_non_ref
|
||||||
|
! k = k+1
|
||||||
|
! ! f is such that f.\tilde{c_i} = c_i
|
||||||
|
! f = psi_non_ref_coef(i,1) / rho_mrcc(i,1)
|
||||||
|
!
|
||||||
|
! ! Avoid numerical instabilities
|
||||||
|
! f = min(f,2.d0)
|
||||||
|
! f = max(f,-2.d0)
|
||||||
|
!
|
||||||
|
! f = 1.d0
|
||||||
|
!
|
||||||
|
! u_0(k) = rho_mrcc(i,1)*f
|
||||||
|
! keys_tmp(:,:,k) = psi_non_ref(:,:,i)
|
||||||
|
! norm += u_0(k)**2
|
||||||
|
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||||
|
! print *, 'Energy of |(1+T)Psi_0> : ', e_0 + nuclear_repulsion, overlap
|
||||||
|
!
|
||||||
|
! f = 1.d0/norm
|
||||||
|
! norm = 1.d0
|
||||||
|
! do i=1,N_det_ref
|
||||||
|
! norm = norm - psi_ref_coef(i,s)*psi_ref_coef(i,s)
|
||||||
|
! enddo
|
||||||
|
! f = dsqrt(f*norm)
|
||||||
|
! overlap = norm
|
||||||
|
! do i=1,N_det_non_ref
|
||||||
|
! u_0(k) = rho_mrcc(i,1)*f
|
||||||
|
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||||
|
! print *, 'Energy of |(1+T)Psi_0> (normalized) : ', e_0 + nuclear_repulsion, overlap
|
||||||
|
!
|
||||||
|
! k=0
|
||||||
|
! overlap = 0.d0
|
||||||
|
! do i=1,N_det_ref
|
||||||
|
! k = k+1
|
||||||
|
! u_0(k) = psi_ref_coef(i,1)
|
||||||
|
! keys_tmp(:,:,k) = psi_ref(:,:,i)
|
||||||
|
! overlap += u_0(k)*psi_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
! norm = 0.d0
|
||||||
|
! do i=1,N_det_non_ref
|
||||||
|
! k = k+1
|
||||||
|
! ! f is such that f.\tilde{c_i} = c_i
|
||||||
|
! f = psi_non_ref_coef(i,1) / rho_mrcc(i,1)
|
||||||
|
!
|
||||||
|
! ! Avoid numerical instabilities
|
||||||
|
! f = min(f,2.d0)
|
||||||
|
! f = max(f,-2.d0)
|
||||||
|
!
|
||||||
|
! u_0(k) = rho_mrcc(i,1)*f
|
||||||
|
! keys_tmp(:,:,k) = psi_non_ref(:,:,i)
|
||||||
|
! norm += u_0(k)**2
|
||||||
|
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||||
|
! print *, 'Energy of |(1+T)Psi_0> (mu_i): ', e_0 + nuclear_repulsion, overlap
|
||||||
|
!
|
||||||
|
! f = 1.d0/norm
|
||||||
|
! norm = 1.d0
|
||||||
|
! do i=1,N_det_ref
|
||||||
|
! norm = norm - psi_ref_coef(i,s)*psi_ref_coef(i,s)
|
||||||
|
! enddo
|
||||||
|
! overlap = norm
|
||||||
|
! f = dsqrt(f*norm)
|
||||||
|
! do i=1,N_det_non_ref
|
||||||
|
! u_0(k) = rho_mrcc(i,1)*f
|
||||||
|
! overlap += u_0(k)*psi_non_ref_coef(i,1)
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det)
|
||||||
|
! print *, 'Energy of |(1+T)Psi_0> (normalized mu_i) : ', e_0 + nuclear_repulsion, overlap
|
||||||
|
!
|
||||||
|
! deallocate(u_0, keys_tmp)
|
||||||
|
!
|
||||||
|
!---------------
|
||||||
|
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
double precision :: f
|
double precision :: f
|
||||||
@ -971,6 +1083,7 @@ END_PROVIDER
|
|||||||
|
|
||||||
dIj_unique(:size(X), s) = X(:)
|
dIj_unique(:size(X), s) = X(:)
|
||||||
end do
|
end do
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
@ -451,7 +451,7 @@
|
|||||||
|
|
||||||
enddo !big loop over symmetry
|
enddo !big loop over symmetry
|
||||||
|
|
||||||
10 format (4E18.12)
|
10 format (4E19.12)
|
||||||
|
|
||||||
|
|
||||||
! Now we copyt the newcmo into the mo_coef
|
! Now we copyt the newcmo into the mo_coef
|
||||||
|
@ -23,7 +23,7 @@ interface: ezfio
|
|||||||
type: Threshold
|
type: Threshold
|
||||||
doc: Threshold on the convergence of the dressed CI energy
|
doc: Threshold on the convergence of the dressed CI energy
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: 1.e-4
|
default: 5.e-5
|
||||||
|
|
||||||
[n_it_max_dressed_ci]
|
[n_it_max_dressed_ci]
|
||||||
type: Strictly_positive_int
|
type: Strictly_positive_int
|
||||||
|
@ -299,7 +299,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,i_generator,n_selected,det_buffe
|
|||||||
delta_ii_(i_state,i_I) = 0.d0
|
delta_ii_(i_state,i_I) = 0.d0
|
||||||
do l_sd=1,idx_alpha(0)
|
do l_sd=1,idx_alpha(0)
|
||||||
k_sd = idx_alpha(l_sd)
|
k_sd = idx_alpha(l_sd)
|
||||||
delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd)
|
delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + 0.5d0*dIa_hla(i_state,k_sd)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -554,7 +554,6 @@ END_PROVIDER
|
|||||||
do k=1,N_det_non_ref
|
do k=1,N_det_non_ref
|
||||||
|
|
||||||
call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk)
|
call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk)
|
||||||
call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki)
|
|
||||||
|
|
||||||
delta_cas(i,j,i_state) += Hjk * dij(i, k, i_state) ! * Hki * lambda_mrcc(i_state, k)
|
delta_cas(i,j,i_state) += Hjk * dij(i, k, i_state) ! * Hki * lambda_mrcc(i_state, k)
|
||||||
!print *, Hjk * get_dij(psi_ref(1,1,i), psi_non_ref(1,1,k), N_int), Hki * get_dij(psi_ref(1,1,j), psi_non_ref(1,1,k), N_int)
|
!print *, Hjk * get_dij(psi_ref(1,1,i), psi_non_ref(1,1,k), N_int), Hki * get_dij(psi_ref(1,1,j), psi_non_ref(1,1,k), N_int)
|
||||||
@ -647,7 +646,7 @@ end function
|
|||||||
integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, sortRefIdx(N_det_ref)
|
integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, sortRefIdx(N_det_ref)
|
||||||
logical :: ok
|
logical :: ok
|
||||||
double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1)
|
double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1)
|
||||||
double precision :: contrib, HIIi, HJk, wall
|
double precision :: contrib, contrib2, HIIi, HJk, wall
|
||||||
integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ
|
integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ
|
||||||
integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2)
|
integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2)
|
||||||
integer(bit_kind),allocatable :: sortRef(:,:,:)
|
integer(bit_kind),allocatable :: sortRef(:,:,:)
|
||||||
@ -677,7 +676,7 @@ end function
|
|||||||
delta_mrcepa0_ij(:,:,:) = 0d0
|
delta_mrcepa0_ij(:,:,:) = 0d0
|
||||||
|
|
||||||
!$OMP PARALLEL DO default(none) schedule(dynamic) shared(delta_mrcepa0_ij, delta_mrcepa0_ii) &
|
!$OMP PARALLEL DO default(none) schedule(dynamic) shared(delta_mrcepa0_ij, delta_mrcepa0_ii) &
|
||||||
!$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib) &
|
!$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib,contrib2) &
|
||||||
!$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) &
|
!$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) &
|
||||||
!$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas) &
|
!$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas) &
|
||||||
!$OMP shared(notf,i_state, sortRef, sortRefIdx, dij)
|
!$OMP shared(notf,i_state, sortRef, sortRefIdx, dij)
|
||||||
@ -720,16 +719,18 @@ end function
|
|||||||
!$OMP ATOMIC
|
!$OMP ATOMIC
|
||||||
notf = notf+1
|
notf = notf+1
|
||||||
|
|
||||||
call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk)
|
! call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk)
|
||||||
!contrib = delta_cas(II, J, i_state) * HJk * lambda_mrcc(i_state, det_cepa0_idx(k))
|
|
||||||
contrib = delta_cas(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state)
|
contrib = delta_cas(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state)
|
||||||
!$OMP ATOMIC
|
|
||||||
delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib
|
|
||||||
|
|
||||||
if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then
|
if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then
|
||||||
|
contrib2 = contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state)
|
||||||
!$OMP ATOMIC
|
!$OMP ATOMIC
|
||||||
delta_mrcepa0_ii(J,i_state) -= contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state)
|
delta_mrcepa0_ii(J,i_state) -= contrib2
|
||||||
|
else
|
||||||
|
contrib = contrib * 0.5d0
|
||||||
end if
|
end if
|
||||||
|
!$OMP ATOMIC
|
||||||
|
delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib
|
||||||
|
|
||||||
end do kloop
|
end do kloop
|
||||||
end do
|
end do
|
||||||
@ -753,7 +754,7 @@ END_PROVIDER
|
|||||||
integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_
|
integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_
|
||||||
logical :: ok
|
logical :: ok
|
||||||
double precision :: phase_Ji, phase_Ik, phase_Ii
|
double precision :: phase_Ji, phase_Ik, phase_Ii
|
||||||
double precision :: contrib, delta_IJk, HJk, HIk, HIl
|
double precision :: contrib, contrib2, delta_IJk, HJk, HIk, HIl
|
||||||
integer, dimension(0:2,2,2) :: exc_Ik, exc_Ji, exc_Ii
|
integer, dimension(0:2,2,2) :: exc_Ik, exc_Ji, exc_Ii
|
||||||
integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2)
|
integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2)
|
||||||
integer, allocatable :: idx_sorted_bit(:)
|
integer, allocatable :: idx_sorted_bit(:)
|
||||||
@ -778,7 +779,7 @@ END_PROVIDER
|
|||||||
!$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_sub_ij, delta_sub_ii) &
|
!$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_sub_ij, delta_sub_ii) &
|
||||||
!$OMP private(i, J, k, degree, degree2, l, deg, ni) &
|
!$OMP private(i, J, k, degree, degree2, l, deg, ni) &
|
||||||
!$OMP private(p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) &
|
!$OMP private(p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) &
|
||||||
!$OMP private(ok, phase_Ji, phase_Ik, phase_Ii, contrib, delta_IJk, HJk, HIk, HIl, exc_Ik, exc_Ji, exc_Ii) &
|
!$OMP private(ok, phase_Ji, phase_Ik, phase_Ii, contrib2, contrib, delta_IJk, HJk, HIk, HIl, exc_Ik, exc_Ji, exc_Ii) &
|
||||||
!$OMP private(det_tmp, det_tmp2, II, blok) &
|
!$OMP private(det_tmp, det_tmp2, II, blok) &
|
||||||
!$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) &
|
!$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) &
|
||||||
!$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb)
|
!$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb)
|
||||||
@ -828,12 +829,15 @@ END_PROVIDER
|
|||||||
call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int)
|
call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int)
|
||||||
if(ok) cycle
|
if(ok) cycle
|
||||||
contrib = delta_IJk * HIl * lambda_mrcc(i_state,l)
|
contrib = delta_IJk * HIl * lambda_mrcc(i_state,l)
|
||||||
|
if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then
|
||||||
|
contrib2 = contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state)
|
||||||
|
!$OMP ATOMIC
|
||||||
|
delta_sub_ii(II,i_state) -= contrib2
|
||||||
|
else
|
||||||
|
contrib = contrib * 0.5d0
|
||||||
|
endif
|
||||||
!$OMP ATOMIC
|
!$OMP ATOMIC
|
||||||
delta_sub_ij(II, i, i_state) += contrib
|
delta_sub_ij(II, i, i_state) += contrib
|
||||||
if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then
|
|
||||||
!$OMP ATOMIC
|
|
||||||
delta_sub_ii(II,i_state) -= contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state)
|
|
||||||
endif
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
@ -501,7 +501,7 @@ subroutine davidson_miniserver_end()
|
|||||||
integer rc
|
integer rc
|
||||||
character*(64) buf
|
character*(64) buf
|
||||||
|
|
||||||
address = trim(qp_run_address_tcp)//':11223'
|
address = trim(qp_run_address)//':11223'
|
||||||
requester = f77_zmq_socket(zmq_context, ZMQ_REQ)
|
requester = f77_zmq_socket(zmq_context, ZMQ_REQ)
|
||||||
rc = f77_zmq_connect(requester,address)
|
rc = f77_zmq_connect(requester,address)
|
||||||
|
|
||||||
@ -520,7 +520,7 @@ subroutine davidson_miniserver_get()
|
|||||||
character*(20) buffer
|
character*(20) buffer
|
||||||
integer rc
|
integer rc
|
||||||
|
|
||||||
address = trim(qp_run_address_tcp)//':11223'
|
address = trim(qp_run_address)//':11223'
|
||||||
|
|
||||||
requester = f77_zmq_socket(zmq_context, ZMQ_REQ)
|
requester = f77_zmq_socket(zmq_context, ZMQ_REQ)
|
||||||
rc = f77_zmq_connect(requester,address)
|
rc = f77_zmq_connect(requester,address)
|
||||||
|
@ -109,8 +109,6 @@ integer function get_index_in_psi_det_sorted_bit(key,Nint)
|
|||||||
continue
|
continue
|
||||||
else
|
else
|
||||||
in_wavefunction = .True.
|
in_wavefunction = .True.
|
||||||
!DIR$ IVDEP
|
|
||||||
!DIR$ LOOP COUNT MIN(3)
|
|
||||||
do l=2,Nint
|
do l=2,Nint
|
||||||
if ( (key(l,1) /= psi_det_sorted_bit(l,1,i)).or. &
|
if ( (key(l,1) /= psi_det_sorted_bit(l,1,i)).or. &
|
||||||
(key(l,2) /= psi_det_sorted_bit(l,2,i)) ) then
|
(key(l,2) /= psi_det_sorted_bit(l,2,i)) ) then
|
||||||
@ -175,7 +173,6 @@ logical function is_connected_to(key,keys,Nint,Ndet)
|
|||||||
do i=1,Ndet
|
do i=1,Ndet
|
||||||
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
||||||
popcnt(xor( key(1,2), keys(1,2,i)))
|
popcnt(xor( key(1,2), keys(1,2,i)))
|
||||||
!DEC$ LOOP COUNT MIN(3)
|
|
||||||
do l=2,Nint
|
do l=2,Nint
|
||||||
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
||||||
popcnt(xor( key(l,2), keys(l,2,i)))
|
popcnt(xor( key(l,2), keys(l,2,i)))
|
||||||
@ -231,7 +228,6 @@ logical function is_connected_to_by_mono(key,keys,Nint,Ndet)
|
|||||||
do i=1,Ndet
|
do i=1,Ndet
|
||||||
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
||||||
popcnt(xor( key(1,2), keys(1,2,i)))
|
popcnt(xor( key(1,2), keys(1,2,i)))
|
||||||
!DEC$ LOOP COUNT MIN(3)
|
|
||||||
do l=2,Nint
|
do l=2,Nint
|
||||||
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
||||||
popcnt(xor( key(l,2), keys(l,2,i)))
|
popcnt(xor( key(l,2), keys(l,2,i)))
|
||||||
@ -325,10 +321,12 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet)
|
|||||||
do i=N_past-1,1,-1
|
do i=N_past-1,1,-1
|
||||||
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
||||||
popcnt(xor( key(1,2), keys(1,2,i)))
|
popcnt(xor( key(1,2), keys(1,2,i)))
|
||||||
!DEC$ LOOP COUNT MIN(3)
|
|
||||||
do l=2,Nint
|
do l=2,Nint
|
||||||
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
||||||
popcnt(xor( key(l,2), keys(l,2,i)))
|
popcnt(xor( key(l,2), keys(l,2,i)))
|
||||||
|
if (degree_x2 > 4) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
enddo
|
enddo
|
||||||
if (degree_x2 > 4) then
|
if (degree_x2 > 4) then
|
||||||
cycle
|
cycle
|
||||||
@ -429,7 +427,6 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet)
|
|||||||
do i=N_past-1,1,-1
|
do i=N_past-1,1,-1
|
||||||
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
||||||
popcnt(xor( key(1,2), keys(1,2,i)))
|
popcnt(xor( key(1,2), keys(1,2,i)))
|
||||||
!DEC$ LOOP COUNT MIN(3)
|
|
||||||
do l=2,Nint
|
do l=2,Nint
|
||||||
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
|
||||||
popcnt(xor( key(l,2), keys(l,2,i)))
|
popcnt(xor( key(l,2), keys(l,2,i)))
|
||||||
|
@ -300,7 +300,6 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
|||||||
else
|
else
|
||||||
|
|
||||||
|
|
||||||
integer, save :: icount(4) = (/0,0,0,0/)
|
|
||||||
!DIR$ LOOP COUNT (1000)
|
!DIR$ LOOP COUNT (1000)
|
||||||
outer: do i=1,sze
|
outer: do i=1,sze
|
||||||
degree_x2 = 0
|
degree_x2 = 0
|
||||||
@ -318,7 +317,6 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
|
|||||||
enddo
|
enddo
|
||||||
idx(l) = i
|
idx(l) = i
|
||||||
l = l+1
|
l = l+1
|
||||||
icount(3) = icount(3) + 1_8
|
|
||||||
enddo outer
|
enddo outer
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
@ -1320,7 +1320,6 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
|||||||
l=1
|
l=1
|
||||||
if (Nint==1) then
|
if (Nint==1) then
|
||||||
|
|
||||||
!DIR$ LOOP COUNT (1000)
|
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||||
popcnt(xor( key1(1,2,i), key2(1,2)))
|
popcnt(xor( key1(1,2,i), key2(1,2)))
|
||||||
@ -1335,7 +1334,6 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
|||||||
|
|
||||||
else if (Nint==2) then
|
else if (Nint==2) then
|
||||||
|
|
||||||
!DIR$ LOOP COUNT (1000)
|
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||||
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
||||||
@ -1352,7 +1350,6 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
|||||||
|
|
||||||
else if (Nint==3) then
|
else if (Nint==3) then
|
||||||
|
|
||||||
!DIR$ LOOP COUNT (1000)
|
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
d = popcnt(xor( key1(1,1,i), key2(1,1))) + &
|
||||||
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
popcnt(xor( key1(1,2,i), key2(1,2))) + &
|
||||||
@ -1371,10 +1368,8 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
|||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
!DIR$ LOOP COUNT (1000)
|
|
||||||
do i=1,sze
|
do i=1,sze
|
||||||
d = 0
|
d = 0
|
||||||
!DIR$ LOOP COUNT MIN(4)
|
|
||||||
do m=1,Nint
|
do m=1,Nint
|
||||||
d = d + popcnt(xor( key1(m,1,i), key2(m,1))) &
|
d = d + popcnt(xor( key1(m,1,i), key2(m,1))) &
|
||||||
+ popcnt(xor( key1(m,2,i), key2(m,2)))
|
+ popcnt(xor( key1(m,2,i), key2(m,2)))
|
||||||
|
@ -17,8 +17,6 @@ END_PROVIDER
|
|||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ character*(128), qp_run_address ]
|
BEGIN_PROVIDER [ character*(128), qp_run_address ]
|
||||||
&BEGIN_PROVIDER [ character*(128), qp_run_address_ipc ]
|
|
||||||
&BEGIN_PROVIDER [ character*(128), qp_run_address_tcp ]
|
|
||||||
&BEGIN_PROVIDER [ integer, zmq_port_start ]
|
&BEGIN_PROVIDER [ integer, zmq_port_start ]
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
@ -36,22 +34,19 @@ END_PROVIDER
|
|||||||
integer :: i
|
integer :: i
|
||||||
do i=len(buffer),1,-1
|
do i=len(buffer),1,-1
|
||||||
if ( buffer(i:i) == ':') then
|
if ( buffer(i:i) == ':') then
|
||||||
qp_run_address_tcp = trim(buffer(1:i-1))
|
qp_run_address = trim(buffer(1:i-1))
|
||||||
read(buffer(i+1:), *) zmq_port_start
|
read(buffer(i+1:), *) zmq_port_start
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
qp_run_address_ipc = 'ipc:///tmp/qp_run'
|
|
||||||
qp_run_address = qp_run_address_ipc
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ character*(128), zmq_socket_pull_tcp_address ]
|
BEGIN_PROVIDER [ character*(128), zmq_socket_pull_tcp_address ]
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_pull_inproc_address ]
|
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_pair_inproc_address ]
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_pair_inproc_address ]
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_push_tcp_address ]
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_push_tcp_address ]
|
||||||
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_pull_inproc_address ]
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_push_inproc_address ]
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_push_inproc_address ]
|
||||||
&BEGIN_PROVIDER [ character*(128), zmq_socket_sub_address ]
|
&BEGIN_PROVIDER [ character*(128), zmq_socket_sub_tcp_address ]
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -59,12 +54,12 @@ END_PROVIDER
|
|||||||
END_DOC
|
END_DOC
|
||||||
character*(8), external :: zmq_port
|
character*(8), external :: zmq_port
|
||||||
|
|
||||||
|
zmq_socket_sub_tcp_address = trim(qp_run_address)//':'//zmq_port(1)//' '
|
||||||
zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(2)//' '
|
zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(2)//' '
|
||||||
|
zmq_socket_push_tcp_address = trim(qp_run_address)//':'//zmq_port(2)//' '
|
||||||
zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(2)//' '
|
zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(2)//' '
|
||||||
zmq_socket_pair_inproc_address = 'inproc://'//zmq_port(3)//' '
|
|
||||||
zmq_socket_push_tcp_address = trim(qp_run_address_tcp)//':'//zmq_port(2)//' '
|
|
||||||
zmq_socket_push_inproc_address = zmq_socket_pull_inproc_address
|
zmq_socket_push_inproc_address = zmq_socket_pull_inproc_address
|
||||||
zmq_socket_sub_address = trim(qp_run_address)//':'//zmq_port(1)//' '
|
zmq_socket_pair_inproc_address = 'inproc://'//zmq_port(3)//' '
|
||||||
|
|
||||||
! /!\ Don't forget to change subroutine reset_zmq_addresses
|
! /!\ Don't forget to change subroutine reset_zmq_addresses
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
@ -77,13 +72,12 @@ subroutine reset_zmq_addresses
|
|||||||
END_DOC
|
END_DOC
|
||||||
character*(8), external :: zmq_port
|
character*(8), external :: zmq_port
|
||||||
|
|
||||||
|
zmq_socket_sub_tcp_address = trim(qp_run_address)//':'//zmq_port(1)//' '
|
||||||
zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(2)//' '
|
zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(2)//' '
|
||||||
|
zmq_socket_push_tcp_address = trim(qp_run_address)//':'//zmq_port(2)//' '
|
||||||
zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(2)//' '
|
zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(2)//' '
|
||||||
zmq_socket_pair_inproc_address = 'inproc://'//zmq_port(3)//' '
|
|
||||||
zmq_socket_push_tcp_address = trim(qp_run_address_tcp)//':'//zmq_port(2)//' '
|
|
||||||
zmq_socket_push_inproc_address = zmq_socket_pull_inproc_address
|
zmq_socket_push_inproc_address = zmq_socket_pull_inproc_address
|
||||||
zmq_socket_sub_address = trim(qp_run_address)//':'//zmq_port(1)//' '
|
zmq_socket_pair_inproc_address = 'inproc://'//zmq_port(3)//' '
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -111,7 +105,6 @@ subroutine switch_qp_run_to_master
|
|||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
qp_run_address_tcp = qp_run_address
|
|
||||||
call reset_zmq_addresses
|
call reset_zmq_addresses
|
||||||
|
|
||||||
end
|
end
|
||||||
@ -374,7 +367,7 @@ function new_zmq_sub_socket()
|
|||||||
stop 'Unable to subscribe new_zmq_sub_socket'
|
stop 'Unable to subscribe new_zmq_sub_socket'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_connect(new_zmq_sub_socket, zmq_socket_sub_address)
|
rc = f77_zmq_connect(new_zmq_sub_socket, zmq_socket_sub_tcp_address)
|
||||||
if (rc /= 0) then
|
if (rc /= 0) then
|
||||||
stop 'Unable to connect new_zmq_sub_socket'
|
stop 'Unable to connect new_zmq_sub_socket'
|
||||||
endif
|
endif
|
||||||
|
Loading…
Reference in New Issue
Block a user