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

Fixed travis

Browse Source
This commit is contained in:
Anthony Scemama 2017-11-27 13:43:05 +01:00
parent 37c05e25e2
commit 1705a29815
4 changed files with 8 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f
View File

@ -1,79 +0,0 @@
use bitmasks
BEGIN_PROVIDER [integer, exc_degree_per_selectors, (N_det_selectors)]
&BEGIN_PROVIDER [integer, double_index_selectors, (N_det_selectors)]
&BEGIN_PROVIDER [integer, n_double_selectors]
implicit none
BEGIN_DOC
! degree of excitation respect to Hartree Fock for the wave function
!
! for the all the selectors determinants
!
! double_index_selectors = list of the index of the double excitations
!
! n_double_selectors = number of double excitations in the selectors determinants
END_DOC
integer :: i,degree
n_double_selectors = 0
do i = 1, N_det_selectors
call get_excitation_degree(psi_selectors(1,1,i),ref_bitmask,degree,N_int)
exc_degree_per_selectors(i) = degree
if(degree==2)then
n_double_selectors += 1
double_index_selectors(n_double_selectors) =i
endif
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, coef_hf_selector]
&BEGIN_PROVIDER[double precision, inv_selectors_coef_hf]
&BEGIN_PROVIDER[double precision, inv_selectors_coef_hf_squared]
&BEGIN_PROVIDER[double precision, E_corr_per_selectors, (N_det_selectors)]
&BEGIN_PROVIDER[double precision, i_H_HF_per_selectors, (N_det_selectors)]
&BEGIN_PROVIDER[double precision, Delta_E_per_selector, (N_det_selectors)]
&BEGIN_PROVIDER[double precision, E_corr_double_only ]
&BEGIN_PROVIDER[double precision, E_corr_second_order ]
implicit none
BEGIN_DOC
! energy of correlation per determinant respect to the Hartree Fock determinant
!
! for the all the double excitations in the selectors determinants
!
! E_corr_per_selectors(i) = <D_i|H|HF> * c(D_i)/c(HF) if |D_i> is a double excitation
!
! E_corr_per_selectors(i) = -1000.d0 if it is not a double excitation
!
! coef_hf_selector = coefficient of the Hartree Fock determinant in the selectors determinants
END_DOC
PROVIDE ref_bitmask_energy psi_selectors ref_bitmask N_int psi_selectors
integer :: i,degree
double precision :: hij,diag_H_mat_elem
E_corr_double_only = 0.d0
E_corr_second_order = 0.d0
do i = 1, N_det_selectors
if(exc_degree_per_selectors(i)==2)then
call i_H_j(ref_bitmask,psi_selectors(1,1,i),N_int,hij)
i_H_HF_per_selectors(i) = hij
E_corr_per_selectors(i) = psi_selectors_coef(i,1) * hij
E_corr_double_only += E_corr_per_selectors(i)
! E_corr_second_order += hij * hij /(ref_bitmask_energy - diag_H_mat_elem(psi_selectors(1,1,i),N_int))
elseif(exc_degree_per_selectors(i) == 0)then
coef_hf_selector = psi_selectors_coef(i,1)
E_corr_per_selectors(i) = -1000.d0
Delta_E_per_selector(i) = 0.d0
else
E_corr_per_selectors(i) = -1000.d0
endif
enddo
if (dabs(coef_hf_selector) > 1.d-8) then
inv_selectors_coef_hf = 1.d0/coef_hf_selector
inv_selectors_coef_hf_squared = inv_selectors_coef_hf * inv_selectors_coef_hf
else
inv_selectors_coef_hf = 0.d0
inv_selectors_coef_hf_squared = 0.d0
endif
do i = 1,n_double_selectors
E_corr_per_selectors(double_index_selectors(i)) *=inv_selectors_coef_hf
enddo
E_corr_double_only = E_corr_double_only * inv_selectors_coef_hf
END_PROVIDER

4
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -49,8 +49,8 @@ subroutine ZMQ_selection(N_in, pt2)
endif
call zmq_set_running(zmq_to_qp_run_socket)
ASSERT (allocated(b%det))
ASSERT (allocated(b%val))
ASSERT (associated(b%det))
ASSERT (associated(b%val))
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
i = omp_get_thread_num()

73
plugins/QMC/dressed_dmc.irp.f
View File

@ -1,73 +0,0 @@
program dressed_dmc
implicit none
double precision :: E0, hij
double precision, allocatable :: H_jj(:), energies(:), delta_jj(:), cj(:), hj(:)
integer :: i
double precision, external :: diag_h_mat_elem
if (.not.read_wf) then
stop 'read_wf should be true'
endif
PROVIDE mo_bielec_integrals_in_map
allocate ( H_jj(N_det), delta_jj(N_det), hj(N_det), cj(N_det), energies(N_states) )
! Read <i|\Phi_0>
! -=-=-=-==-=-=-=
character*(32) :: w, w2
integer :: k
do while (.True.)
read(*,*) w
if ( trim(w) == 'Ci_h_psidet' ) then
exit
endif
enddo
do i=1,N_det
read(*,*) k, w, hj(i)
enddo
do while (.True.)
read(*,*) w
if ( trim(w) == 'Ci_overlap_psidet' ) then
exit
endif
enddo
do i=1,N_det
read(*,*) k, w, cj(i)
enddo
read(*,*)
read(*,*) w, w2, E0
print *, 'E0=', E0
print *, 'Ndet = ', N_det
! Compute delta_ii
! -=-=-=-==-=-=-=-
do i=1,N_det
call i_H_psi(psi_det(1,1,i),psi_det,cj,N_int,N_det,size(psi_coef,1),N_states,energies)
if (dabs(cj(i)) < 1.d-6) then
delta_jj(i) = 0.d0
else
delta_jj(i) = (hj(i) - energies(1))/cj(i)
endif
H_jj(i) = diag_h_mat_elem(psi_det(1,1,i),N_int) + delta_jj(i)
print *, 'Delta_jj(',i,') = ', Delta_jj(i), H_jj(i)
enddo
call davidson_diag_hjj(psi_det,psi_coef,H_jj,energies,size(psi_coef,1),N_det,N_states,N_states_diag,N_int,6)
call save_wavefunction
call write_spindeterminants
E0 = 0.d0
do i=1,N_det
call i_H_psi(psi_det(1,1,i),psi_det,psi_coef(1,1),N_int,N_det,size(psi_coef,1),N_states,energies)
E0 += psi_coef(i,1) * energies(1)
enddo
print *, 'Trial energy: ', E0 + nuclear_repulsion
deallocate (H_jj, delta_jj, energies, cj)
end

10
src/Determinants/zmq.irp.f
View File

@ -102,7 +102,8 @@ subroutine zmq_put_psi_det(zmq_to_qp_run_socket,worker_id)
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
integer, intent(in) :: worker_id
integer :: rc, rc8
integer :: rc
integer*8 :: rc8
character*(256) :: msg
write(msg,'(A8,1X,I8,1X,A230)') 'put_data', worker_id, 'psi_det'
@ -112,7 +113,7 @@ subroutine zmq_put_psi_det(zmq_to_qp_run_socket,worker_id)
stop 'error'
endif
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,0)
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
if (rc8 /= N_int*2_8*N_det*bit_kind) then
print *, irp_here, ': Error sending psi_det'
stop 'error'
@ -134,7 +135,8 @@ subroutine zmq_put_psi_coef(zmq_to_qp_run_socket,worker_id)
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
integer, intent(in) :: worker_id
integer :: rc, rc8
integer :: rc
integer*8 :: rc8
character*(256) :: msg
write(msg,'(A8,1X,I8,1X,A230)') 'put_data', worker_id, 'psi_coef'
@ -144,7 +146,7 @@ subroutine zmq_put_psi_coef(zmq_to_qp_run_socket,worker_id)
stop 'error'
endif
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,0)
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
if (rc8 /= psi_det_size*N_states*8_8) then
print *, irp_here, ': Error sending psi_coef'
stop 'error'