mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-25 13:53:49 +01:00
non-working mrcc_sto
This commit is contained in:
parent
95a1cddf43
commit
10ffd8f789
@ -86,7 +86,7 @@ END_PROVIDER
|
||||
else
|
||||
errr = 1d-4
|
||||
end if
|
||||
relative_error = errr
|
||||
relative_error = errr * 0d0
|
||||
print *, "RELATIVE ERROR", relative_error
|
||||
call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error))
|
||||
|
||||
|
@ -11,19 +11,22 @@
|
||||
double precision :: f, tmp
|
||||
double precision, external :: u_dot_v
|
||||
|
||||
print *, "DELTA_IJ", delta_ij(1,:10,1)
|
||||
print *, "DELTA_IJ div", delta_ij(1,:10,1) / psi_coef(dressed_column_idx(1),1)
|
||||
!stop
|
||||
do k=1,N_states
|
||||
l = dressed_column_idx(k)
|
||||
f = 1.d0/psi_coef(l,k)
|
||||
do jj = 1, n_det
|
||||
j = jj !idx_non_ref(jj)
|
||||
dressing_column_h(j,k) = delta_ij (k,jj,1)
|
||||
dressing_column_s(j,k) = delta_ij (k,jj,2)!delta_ij_s2(k,jj)
|
||||
dressing_column_h(j,k) = delta_ij (k,jj,1) * f
|
||||
dressing_column_s(j,k) = delta_ij (k,jj,2) * f!delta_ij_s2(k,jj)
|
||||
enddo
|
||||
tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det)
|
||||
dressing_column_h(l,k) -= tmp * f
|
||||
tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det)
|
||||
dressing_column_s(l,k) -= tmp * f
|
||||
enddo
|
||||
|
||||
!stop
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -57,12 +57,12 @@ subroutine run_dress_slave(thread,iproc,energy)
|
||||
call alpha_callback(delta_ij_loc, i_generator, subset)
|
||||
|
||||
!!! SET DRESSING COLUMN?
|
||||
do i=1,N_det
|
||||
do i_state=1,N_states
|
||||
delta_ij_loc(i_state,i,1) = delta_ij_loc(i_state,i,1) / div(i_state)
|
||||
delta_ij_loc(i_state,i,2) = delta_ij_loc(i_state,i,2) / div(i_state)
|
||||
end do
|
||||
end do
|
||||
!do i=1,N_det
|
||||
! do i_state=1,N_states
|
||||
! delta_ij_loc(i_state,i,1) = delta_ij_loc(i_state,i,1) / div(i_state)
|
||||
! delta_ij_loc(i_state,i,2) = delta_ij_loc(i_state,i,2) / div(i_state)
|
||||
! end do
|
||||
!end do
|
||||
|
||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
||||
call push_dress_results(zmq_socket_push, i_generator, delta_ij_loc, task_id)
|
||||
|
@ -1,3 +1,4 @@
|
||||
|
||||
program mrcc_sto
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -13,13 +14,205 @@ program mrcc_sto
|
||||
call dress_zmq()
|
||||
end
|
||||
|
||||
BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ]
|
||||
&BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ]
|
||||
implicit none
|
||||
integer :: i,inpsisor
|
||||
|
||||
idx_non_ref_from_sorted = 0
|
||||
psi_from_sorted = 0
|
||||
|
||||
do i=1,N_det
|
||||
psi_from_sorted(psi_det_sorted_order(i)) = i
|
||||
inpsisor = psi_det_sorted_order(i)
|
||||
if(inpsisor <= 0) stop "idx_non_ref_from_sorted"
|
||||
idx_non_ref_from_sorted(inpsisor) = idx_non_ref_rev(i)
|
||||
end do
|
||||
END_PROVIDER
|
||||
|
||||
subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha)
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer(bit_kind), intent(in) :: alpha(N_int,2)
|
||||
integer,intent(in) :: minilist(n_minilist), n_minilist
|
||||
double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2)
|
||||
|
||||
|
||||
integer :: i,j,k,l,m
|
||||
integer :: degree1, degree2, degree
|
||||
integer, allocatable :: idx_alpha(:)
|
||||
|
||||
double precision :: hIk, hla, hIl, sla, dIk(N_states), dka(N_states), dIa(N_states), hka
|
||||
double precision, allocatable :: dIa_hla(:,:), dIa_sla(:,:)
|
||||
double precision :: phase, phase2
|
||||
double precision :: ci_inv(N_states)
|
||||
integer :: exc(0:2,2,2)
|
||||
integer :: h1,h2,p1,p2,s1,s2
|
||||
integer(bit_kind) :: tmp_det(N_int,2)
|
||||
integer :: i_state, k_sd, l_sd, m_sd, ll_sd, i_I
|
||||
double precision, allocatable :: hij_cache(:), sij_cache(:)
|
||||
double precision :: Delta_E_inv(N_states)
|
||||
double precision :: sdress, hdress
|
||||
double precision :: c0(N_states)
|
||||
logical :: ok
|
||||
|
||||
|
||||
if (perturbative_triples) then
|
||||
PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat
|
||||
endif
|
||||
allocate(hij_cache(N_det), sij_cache(N_det))
|
||||
allocate (dIa_hla(N_states,N_det), dIa_sla(N_states,N_det))
|
||||
allocate (idx_alpha(0:n_minilist))
|
||||
|
||||
do i_state=1,N_states
|
||||
c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state)
|
||||
enddo
|
||||
ll_sd = 0
|
||||
do l_sd=1,n_minilist
|
||||
ok = .true.
|
||||
k_sd = minilist(l_sd)
|
||||
!if(idx_non_ref_rev(k_sd) == 0) cycle
|
||||
|
||||
do i_I=1,N_det_ref
|
||||
call get_excitation_degree(psi_det_sorted(1,1,k_sd),psi_ref(1,1,i_I),degree1,N_int)
|
||||
if(degree1 == 0) then
|
||||
ok = .false.
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
|
||||
if( xor(ok, idx_non_ref_from_sorted(k_sd) > 0)) stop "BUGUE"
|
||||
if(ok) then
|
||||
ll_sd += 1
|
||||
idx_alpha(ll_sd) = k_sd
|
||||
! call i_h_j(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,hij_cache(k_sd))
|
||||
! call get_s2(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,sij_cache(k_sd))
|
||||
call i_h_j(alpha,psi_det_sorted(1,1,k_sd),N_int,hij_cache(k_sd))
|
||||
call get_s2(alpha,psi_det_sorted(1,1,k_sd),N_int,sij_cache(k_sd))
|
||||
end if
|
||||
enddo
|
||||
|
||||
idx_alpha(0) = ll_sd
|
||||
|
||||
|
||||
do i_I=1,N_det_ref
|
||||
call get_excitation_degree(alpha,psi_ref(1,1,i_I),degree1,N_int)
|
||||
if (degree1 > 4) then
|
||||
cycle
|
||||
endif
|
||||
|
||||
do i_state=1,N_states
|
||||
dIa(i_state) = 0.d0
|
||||
enddo
|
||||
|
||||
do k_sd=1,idx_alpha(0)
|
||||
!print *, "idx ", k_sd
|
||||
!print *, "idx2", idx_alpha(k_sd)
|
||||
!print *, "ref
|
||||
!if(idx_non_ref_rev(idx_alpha(k_sd)) == 0) cycle
|
||||
call get_excitation_degree(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha(k_sd)),degree,N_int)
|
||||
! print *, "diden"
|
||||
if (degree > 2) then
|
||||
cycle
|
||||
endif
|
||||
|
||||
call get_excitation(psi_det_sorted(1,1,idx_alpha(k_sd)),alpha,exc,degree2,phase,N_int)
|
||||
!print *, "DEG", degree2
|
||||
call decode_exc(exc,degree2,h1,p1,h2,p2,s1,s2)
|
||||
do k=1,N_int
|
||||
tmp_det(k,1) = psi_ref(k,1,i_I)
|
||||
tmp_det(k,2) = psi_ref(k,2,i_I)
|
||||
enddo
|
||||
call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, N_int)
|
||||
|
||||
do i_state=1,N_states
|
||||
dIK(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha(k_sd)), i_state)
|
||||
enddo
|
||||
|
||||
! <I| \l/ |alpha>
|
||||
do i_state=1,N_states
|
||||
dka(i_state) = 0.d0
|
||||
enddo
|
||||
|
||||
if (ok) then
|
||||
do l_sd=k_sd+1,idx_alpha(0)
|
||||
call get_excitation_degree(tmp_det,psi_det_sorted(1,1,idx_alpha(l_sd)),degree,N_int)
|
||||
if (degree == 0) then
|
||||
call get_excitation(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha(l_sd)),exc,degree,phase2,N_int)
|
||||
do i_state=1,N_states
|
||||
dka(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha(l_sd)), i_state) * phase * phase2
|
||||
enddo
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
else if (perturbative_triples) then
|
||||
hka = hij_cache(idx_alpha(k_sd))
|
||||
if (dabs(hka) > 1.d-12) then
|
||||
call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv)
|
||||
|
||||
do i_state=1,N_states
|
||||
ASSERT (Delta_E_inv(i_state) < 0.d0)
|
||||
dka(i_state) = hka / Delta_E_inv(i_state)
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
|
||||
if (perturbative_triples.and. (degree2 == 1) ) then
|
||||
call i_h_j(psi_ref(1,1,i_I),tmp_det,N_int,hka)
|
||||
hka = hij_cache(idx_alpha(k_sd)) - hka
|
||||
if (dabs(hka) > 1.d-12) then
|
||||
call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv)
|
||||
do i_state=1,N_states
|
||||
ASSERT (Delta_E_inv(i_state) < 0.d0)
|
||||
dka(i_state) = hka / Delta_E_inv(i_state)
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
do i_state=1,N_states
|
||||
dIa(i_state) = dIa(i_state) + dIk(i_state) * dka(i_state)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i_state=1,N_states
|
||||
ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state)
|
||||
enddo
|
||||
do l_sd=1,idx_alpha(0)
|
||||
k_sd = idx_alpha(l_sd)
|
||||
hla = hij_cache(k_sd)
|
||||
sla = sij_cache(k_sd)
|
||||
do i_state=1,N_states
|
||||
dIa_hla(i_state,k_sd) = dIa(i_state) * hla
|
||||
dIa_sla(i_state,k_sd) = dIa(i_state) * sla
|
||||
enddo
|
||||
enddo
|
||||
do i_state=1,N_states
|
||||
do l_sd=1,idx_alpha(0)
|
||||
!print *, "DRES"
|
||||
!print *, i_state, idx_alpha(l_sd)
|
||||
k_sd = idx_alpha(l_sd)
|
||||
m_sd = psi_from_sorted(k_sd)
|
||||
if(psi_det(1,1,m_sd) /= psi_det_sorted(1,1,k_sd)) stop "psi_from_sorted foireous"
|
||||
hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state)
|
||||
sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state)
|
||||
!$OMP ATOMIC
|
||||
delta_ij_loc(i_state,m_sd,1) += hdress
|
||||
!$OMP ATOMIC
|
||||
delta_ij_loc(i_state,m_sd,2) += sdress
|
||||
!print *, "ENDRES"
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
end subroutine
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
!! TESTS MINILIST
|
||||
subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha)
|
||||
subroutine test_minilist(minilist, n_minilist, alpha)
|
||||
use bitmasks
|
||||
implicit none
|
||||
double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2)
|
||||
integer, intent(in) :: n_minilist
|
||||
integer(bit_kind),intent(in) :: alpha(N_int, 2)
|
||||
integer, intent(in) :: minilist(n_minilist)
|
||||
@ -47,8 +240,6 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha)
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
|
||||
delta_ij_loc = 0d0
|
||||
end subroutine
|
||||
|
||||
|
||||
|
@ -867,6 +867,7 @@ end
|
||||
else
|
||||
target_error = 1d-4
|
||||
end if
|
||||
target_error = 0d0
|
||||
call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(target_error))
|
||||
|
||||
mrcc_previous_E(:) = mrcc_E0_denominator(:)
|
||||
|
@ -24,6 +24,7 @@
|
||||
tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det)
|
||||
dressing_column_s(l,k) -= tmp * f
|
||||
enddo
|
||||
|
||||
print *, "DRESS", dressing_column_h(:10,1)
|
||||
! stop
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -114,17 +114,17 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error)
|
||||
print *, irp_here, ': Failed in zmq_set_running'
|
||||
endif
|
||||
|
||||
!!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) &
|
||||
! !$OMP PRIVATE(i)
|
||||
!i = omp_get_thread_num()
|
||||
!if (i==0) then
|
||||
! call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc)
|
||||
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) &
|
||||
!$OMP PRIVATE(i)
|
||||
i = omp_get_thread_num()
|
||||
if (i==0) then
|
||||
call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc)
|
||||
!
|
||||
! else
|
||||
! call mrcc_slave_inproc(i)
|
||||
! endif
|
||||
! !$OMP END PARALLEL
|
||||
call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc)
|
||||
else
|
||||
call mrcc_slave_inproc(i)
|
||||
endif
|
||||
!$OMP END PARALLEL
|
||||
! call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc)
|
||||
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'mrcc')
|
||||
|
||||
print *, '========== ================= ================= ================='
|
||||
|
@ -69,7 +69,6 @@ subroutine run_mrcc_slave(thread,iproc,energy)
|
||||
else
|
||||
integer :: i_generator, i_i_generator, subset
|
||||
read (task,*) subset, ind
|
||||
print *, "SLAVE RECEIVED", ind
|
||||
! if(buf%N == 0) then
|
||||
! ! Only first time
|
||||
! call create_selection_buffer(1, 2, buf)
|
||||
|
Loading…
Reference in New Issue
Block a user