diff --git a/plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f b/plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f deleted file mode 100644 index fec480f0..00000000 --- a/plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f +++ /dev/null @@ -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) = * 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 diff --git a/plugins/Full_CI_ZMQ/zmq_selection.irp.f b/plugins/Full_CI_ZMQ/zmq_selection.irp.f index 3e46496a..78d0939c 100644 --- a/plugins/Full_CI_ZMQ/zmq_selection.irp.f +++ b/plugins/Full_CI_ZMQ/zmq_selection.irp.f @@ -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() diff --git a/plugins/QMC/dressed_dmc.irp.f b/plugins/QMC/dressed_dmc.irp.f deleted file mode 100644 index 803e55dc..00000000 --- a/plugins/QMC/dressed_dmc.irp.f +++ /dev/null @@ -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 - ! -=-=-=-==-=-=-= - - 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 diff --git a/src/Determinants/zmq.irp.f b/src/Determinants/zmq.irp.f index b2c1d4e7..c9629d3d 100644 --- a/src/Determinants/zmq.irp.f +++ b/src/Determinants/zmq.irp.f @@ -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'