diff --git a/src/csf/configurations.irp.f b/src/csf/configurations.irp.f index 8e2a513c..ce5d48ab 100644 --- a/src/csf/configurations.irp.f +++ b/src/csf/configurations.irp.f @@ -779,6 +779,7 @@ subroutine binary_search_cfg(cfgInp,addcfg) end subroutine BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det, (2,N_configuration) ] +&BEGIN_PROVIDER [ integer, psi_configuration_n_det, (N_configuration) ] &BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det_data, (N_det) ] implicit none @@ -867,6 +868,29 @@ end subroutine enddo deallocate(dets, old_order) + integer :: ndet_conf + do i = 1, N_configuration + ndet_conf = psi_configuration_to_psi_det(2,i) - psi_configuration_to_psi_det(1,i) + 1 + psi_configuration_n_det(i) = ndet_conf + enddo END_PROVIDER + +BEGIN_PROVIDER [ integer, n_elec_alpha_for_psi_configuration, (N_configuration)] + implicit none + integer :: i,j,k,l + integer(bit_kind) :: det_tmp(N_int,2),det_alpha(N_int) + n_elec_alpha_for_psi_configuration = 0 + do i = 1, N_configuration + j = psi_configuration_to_psi_det(2,i) + det_tmp(:,:) = psi_det(:,:,j) + k = 0 + do l = 1, N_int + det_alpha(N_int) = iand(det_tmp(l,1),psi_configuration(l,1,i)) + k += popcnt(det_alpha(l)) + enddo + n_elec_alpha_for_psi_configuration(i) = k + enddo + +END_PROVIDER diff --git a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f index 2f3d7f80..243e9995 100644 --- a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f +++ b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f @@ -1,5 +1,5 @@ -subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) +subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) use mmap_module implicit none BEGIN_DOC @@ -412,36 +412,6 @@ subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d FREE nthreads_davidson end -subroutine hcalc_template(v,u,N_st,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Template of routine for the application of H - ! - ! Here, it is done with the Hamiltonian matrix - ! - ! on the set of determinants of psi_det - ! - ! Computes $v = H | u \rangle$ - ! - END_DOC - integer, intent(in) :: N_st,sze - double precision, intent(in) :: u(sze,N_st) - double precision, intent(inout) :: v(sze,N_st) - integer :: i,j,istate - v = 0.d0 - do istate = 1, N_st - do i = 1, sze - do j = 1, sze - v(i,istate) += H_matrix_all_dets(j,i) * u(j,istate) - enddo - enddo - do i = 1, sze - v(i,istate) += u(i,istate) * nuclear_repulsion - enddo - enddo -end - subroutine dressing_diag_uv(v,u,dress_diag,N_st,sze) implicit none BEGIN_DOC diff --git a/src/determinants/s2.irp.f b/src/determinants/s2.irp.f index d73b2dbf..2c1a8757 100644 --- a/src/determinants/s2.irp.f +++ b/src/determinants/s2.irp.f @@ -103,13 +103,17 @@ BEGIN_PROVIDER [ double precision, expected_s2] END_PROVIDER -BEGIN_PROVIDER [ double precision, s2_values, (N_states) ] + BEGIN_PROVIDER [ double precision, s2_values, (N_states) ] +&BEGIN_PROVIDER [ double precision, s_values, (N_states) ] implicit none BEGIN_DOC ! array of the averaged values of the S^2 operator on the various states END_DOC integer :: i call u_0_S2_u_0(s2_values,psi_coef,n_det,psi_det,N_int,N_states,psi_det_size) + do i = 1, N_states + s_values(i) = 0.5d0 *(-1.d0 + dsqrt(1.d0 + 4 * s2_values(i))) + enddo END_PROVIDER diff --git a/src/mo_guess/h_core_guess_routine.irp.f b/src/mo_guess/h_core_guess_routine.irp.f index cbf23a9a..fcbdde49 100644 --- a/src/mo_guess/h_core_guess_routine.irp.f +++ b/src/mo_guess/h_core_guess_routine.irp.f @@ -7,7 +7,7 @@ subroutine hcore_guess label = 'Guess' call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, & size(mo_one_e_integrals,1), & - size(mo_one_e_integrals,2),label,1,.false.) + size(mo_one_e_integrals,2),label,1,.true.) call nullify_small_elements(ao_num, mo_num, mo_coef, size(mo_coef,1), 1.d-12 ) call save_mos TOUCH mo_coef mo_label