LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-10 21:18:29 +01:00
Code Issues Releases Wiki Activity

Introduced PT2 energy denomitator provider

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
plugins/Full_CI_ZMQ/fci_zmq.irp.f
View File

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

2
plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f
View File

@ -13,7 +13,7 @@ end
subroutine provide_everything 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 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 end
subroutine run_wf subroutine run_wf

2
plugins/Full_CI_ZMQ/selection_slave.irp.f
View File

@ -13,7 +13,7 @@ end
subroutine provide_everything 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 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 end
subroutine run_wf subroutine run_wf

2
plugins/MRCC_Utils/amplitudes.irp.f
View File

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

23
plugins/MRCC_Utils/davidson.irp.f
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 do k=1,N_st_diag
energies(k) = lambda(k)
do i=1,sze do i=1,sze
u_in(i,k) = 0.d0 u_in(i,k) = 0.d0
enddo enddo
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, & 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, & 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 enddo
do k=1,N_st_diag
energies(k) = lambda(k)
enddo
write_buffer = '===== ' write_buffer = '===== '
do i=1,N_st do i=1,N_st
write_buffer = trim(write_buffer)//' ================ ================' 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, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit, istate
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
double precision, intent(inout) :: u_in(dim_in,N_st_diag) 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, allocatable :: H_jj(:), S2_jj(:)
double precision :: diag_h_mat_elem 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 Vt = 0.d0
St = 0.d0 St = 0.d0
!$OMP DO SCHEDULE(dynamic) !$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,1) do sh=1,shortcut(0,1)
do sh2=sh,shortcut(0,1) do sh2=sh,shortcut(0,1)
exa = 0 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 enddo
enddo enddo
!$OMP END DO NOWAIT !$OMP END DO
!$OMP DO SCHEDULE(dynamic) !$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,2) do sh=1,shortcut(0,2)
do i=shortcut(sh,2),shortcut(sh+1,2)-1 do i=shortcut(sh,2),shortcut(sh+1,2)-1
org_i = sort_idx(i,2) 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
end do end do
enddo enddo
!$OMP END DO NOWAIT !$OMP END DO
! -------------------------- ! --------------------------
! Begin Specific to dressing ! Begin Specific to dressing

5
plugins/MRCC_Utils/mrcc_utils.irp.f
View File

@ -712,7 +712,7 @@ END_PROVIDER
resold = huge(1.d0) resold = huge(1.d0)
do k=0,100000 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 !$OMP DO
do i=1,N_det_non_ref 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(psi_ref(1,1,II), psi_non_ref(1,1,i), s, Nint) * phase
get_dij_index = get_dij_index * rho_mrcc(i,s) get_dij_index = get_dij_index * rho_mrcc(i,s)
else if(lambda_type == 1) then 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) 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) get_dij_index = HIi * lambda_mrcc(s, i)
else if(lambda_type == 2) then else if(lambda_type == 2) then

2
plugins/Selectors_full/selectors.irp.f
View File

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

11
src/Davidson/diagonalization_hs2.irp.f
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, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
double precision, intent(inout) :: u_in(dim_in,N_st_diag) 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, allocatable :: H_jj(:), S2_jj(:)
double precision :: diag_h_mat_elem 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 stop -1
endif endif
PROVIDE nuclear_repulsion PROVIDE nuclear_repulsion expected_s2
call write_time(iunit) call write_time(iunit)
call wall_time(wall) call wall_time(wall)
@ -254,6 +254,8 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), &
0.d0, s_, size(s_,1)) 0.d0, s_, size(s_,1))
do k=1,shift2 do k=1,shift2
s2(k) = s_(k,k) + S_z2_Sz s2(k) = s_(k,k) + S_z2_Sz
enddo enddo
@ -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 ! 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, & 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)) U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
enddo enddo
do k=1,N_st_diag do k=1,N_st_diag
energies(k) = lambda(k)
S2_jj(k) = s2(k) S2_jj(k) = s2(k)
enddo enddo
write_buffer = '===== ' write_buffer = '===== '

8
src/Davidson/u0Hu0.irp.f
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 Vt = 0.d0
St = 0.d0 St = 0.d0
!$OMP DO SCHEDULE(dynamic) !$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,1) do sh=1,shortcut(0,1)
do sh2=sh,shortcut(0,1) do sh2=sh,shortcut(0,1)
exa = 0 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 enddo
enddo enddo
!$OMP END DO NOWAIT !$OMP END DO
!$OMP DO SCHEDULE(dynamic) !$OMP DO SCHEDULE(guided)
do sh=1,shortcut(0,2) do sh=1,shortcut(0,2)
do i=shortcut(sh,2),shortcut(sh+1,2)-1 do i=shortcut(sh,2),shortcut(sh+1,2)-1
org_i = sort_idx(i,2) 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
end do end do
enddo enddo
!$OMP END DO NOWAIT !$OMP END DO
!$OMP CRITICAL !$OMP CRITICAL
do istate=1,N_st do istate=1,N_st