10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-25 22:52:15 +02:00

Introduced PT2 energy denomitator provider

This commit is contained in:
Anthony Scemama 2016-11-11 23:07:58 +01:00
parent b0497c6594
commit fe54cb2675
9 changed files with 36 additions and 45 deletions

View File

@ -123,11 +123,11 @@ subroutine ZMQ_selection(N_in, pt2)
if (.True.) then
PROVIDE pt2_e0_denominator
N = max(N_in,1)
provide nproc
provide ci_electronic_energy
call new_parallel_job(zmq_to_qp_run_socket,"selection")
call zmq_put_psi(zmq_to_qp_run_socket,1,ci_electronic_energy,size(ci_electronic_energy))
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
call zmq_set_running(zmq_to_qp_run_socket)
call create_selection_buffer(N, N*2, b)
endif
@ -144,19 +144,21 @@ subroutine ZMQ_selection(N_in, pt2)
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
end do
!$OMP PARALLEL DEFAULT(none) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) shared(ci_electronic_energy_is_built, n_det_generators_is_built, n_states_is_built, n_int_is_built, nproc_is_built)
i = omp_get_thread_num()
if (i==0) then
call selection_collector(b, pt2)
else
call selection_slave_inproc(i)
endif
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
i = omp_get_thread_num()
if (i==0) then
call selection_collector(b, pt2)
else
call selection_slave_inproc(i)
endif
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, 'selection')
call end_parallel_job(zmq_to_qp_run_socket, 'selection')
if (N_in > 0) then
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN
call copy_H_apply_buffer_to_wf()
call make_s2_eigenfunction
if (s2_eig) then
call make_s2_eigenfunction
endif
endif
end subroutine
@ -165,7 +167,7 @@ subroutine selection_slave_inproc(i)
implicit none
integer, intent(in) :: i
call run_selection_slave(1,i,ci_electronic_energy)
call run_selection_slave(1,i,pt2_e0_denominator)
end
subroutine selection_collector(b, pt2)

View File

@ -13,7 +13,7 @@ end
subroutine provide_everything
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context mo_mono_elec_integral
! PROVIDE ci_electronic_energy mo_tot_num N_int
! PROVIDE pt2_e0_denominator mo_tot_num N_int
end
subroutine run_wf

View File

@ -13,7 +13,7 @@ end
subroutine provide_everything
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
! PROVIDE ci_electronic_energy mo_tot_num N_int
PROVIDE pt2_e0_denominator mo_tot_num N_int
end
subroutine run_wf

View File

@ -62,7 +62,7 @@
deallocate(pathTo)
print *, n_exc_active, "inactive excitations /", hh_nex
print *, n_exc_active, "active excitations /", hh_nex
END_PROVIDER

View File

@ -315,20 +315,10 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
! -----------
do k=1,N_st_diag
energies(k) = lambda(k)
do i=1,sze
u_in(i,k) = 0.d0
enddo
enddo
! do k=1,N_st_diag
! do i=1,sze
! do iter2=1,iter
! do l=1,N_st_diag
! u_in(i,k) += U(i,l,iter2)*y(l,iter2,k,1)
! enddo
! enddo
! enddo
! enddo
call dgemm('N','N', sze, N_st_diag, N_st_diag*iter, 1.d0, &
U, size(U,1), y, N_st_diag*davidson_sze_max, &
@ -336,6 +326,9 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_s
enddo
do k=1,N_st_diag
energies(k) = lambda(k)
enddo
write_buffer = '===== '
do i=1,N_st
write_buffer = trim(write_buffer)//' ================ ================'
@ -557,7 +550,7 @@ subroutine davidson_diag_mrcc_hs2(dets_in,u_in,dim_in,energies,sze,N_st,N_st_dia
integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit, istate
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
double precision, intent(inout) :: u_in(dim_in,N_st_diag)
double precision, intent(out) :: energies(N_st)
double precision, intent(out) :: energies(N_st_diag)
double precision, allocatable :: H_jj(:), S2_jj(:)
double precision :: diag_h_mat_elem
@ -962,7 +955,7 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i
Vt = 0.d0
St = 0.d0
!$OMP DO SCHEDULE(dynamic)
!$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,1)
do sh2=sh,shortcut(0,1)
exa = 0
@ -1004,8 +997,8 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i
enddo
enddo
enddo
!$OMP END DO NOWAIT
!$OMP DO SCHEDULE(dynamic)
!$OMP END DO
!$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,2)
do i=shortcut(sh,2),shortcut(sh+1,2)-1
org_i = sort_idx(i,2)
@ -1028,7 +1021,7 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i
end do
end do
enddo
!$OMP END DO NOWAIT
!$OMP END DO
! --------------------------
! Begin Specific to dressing

View File

@ -712,7 +712,7 @@ END_PROVIDER
resold = huge(1.d0)
do k=0,100000
!$OMP PARALLEL default(shared) private(cx, i, j, a_col, a_coll)
!$OMP PARALLEL default(shared) private(cx, i, a_col, a_coll)
!$OMP DO
do i=1,N_det_non_ref
@ -967,9 +967,6 @@ double precision function get_dij_index(II, i, s, Nint)
get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), s, Nint) * phase
get_dij_index = get_dij_index * rho_mrcc(i,s)
else if(lambda_type == 1) then
call get_phase(psi_ref(1,1,II), psi_non_ref(1,1,i), phase, N_int)
get_dij_index = get_dij(psi_ref(1,1,II), psi_non_ref(1,1,i), s, Nint) * phase
get_dij_index = get_dij_index * rho_mrcc(i,s)
call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,i), Nint, HIi)
get_dij_index = HIi * lambda_mrcc(s, i)
else if(lambda_type == 2) then

View File

@ -14,7 +14,7 @@ BEGIN_PROVIDER [ integer, N_det_selectors]
integer :: i
double precision :: norm, norm_max
call write_time(output_determinants)
N_det_selectors = N_det_generators
N_det_selectors = N_det
if (threshold_generators < 1.d0) then
norm = 0.d0
do i=1,N_det

View File

@ -22,7 +22,7 @@ subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_d
integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
double precision, intent(inout) :: u_in(dim_in,N_st_diag)
double precision, intent(out) :: energies(N_st), s2_out(N_st_diag)
double precision, intent(out) :: energies(N_st_diag), s2_out(N_st_diag)
double precision, allocatable :: H_jj(:), S2_jj(:)
double precision :: diag_h_mat_elem
@ -116,7 +116,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
stop -1
endif
PROVIDE nuclear_repulsion
PROVIDE nuclear_repulsion expected_s2
call write_time(iunit)
call wall_time(wall)
@ -253,6 +253,8 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
call dgemm('T','N',shift2,shift2,shift2, &
1.d0, y, size(y,1), s_tmp, size(s_tmp,1), &
0.d0, s_, size(s_,1))
do k=1,shift2
s2(k) = s_(k,k) + S_z2_Sz
@ -324,16 +326,13 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
! Re-contract to u_in
! -----------
do k=1,N_st_diag
energies(k) = lambda(k)
enddo
call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, &
U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
enddo
do k=1,N_st_diag
energies(k) = lambda(k)
S2_jj(k) = s2(k)
enddo
write_buffer = '===== '

View File

@ -344,7 +344,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
Vt = 0.d0
St = 0.d0
!$OMP DO SCHEDULE(dynamic)
!$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,1)
do sh2=sh,shortcut(0,1)
exa = 0
@ -386,8 +386,8 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
enddo
enddo
enddo
!$OMP END DO NOWAIT
!$OMP DO SCHEDULE(dynamic)
!$OMP END DO
!$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,2)
do i=shortcut(sh,2),shortcut(sh+1,2)-1
org_i = sort_idx(i,2)
@ -410,7 +410,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
end do
end do
enddo
!$OMP END DO NOWAIT
!$OMP END DO
!$OMP CRITICAL
do istate=1,N_st