use bitmasks subroutine collect_lmct(hole_particle,n_couples) implicit none integer, intent(out) :: hole_particle(1000,2), n_couples BEGIN_DOC ! Collect all the couple holes/particles of the important LMCT ! hole_particle(i,1) = ith hole ! hole_particle(i,2) = ith particle ! n_couples is the number of important excitations END_DOC print*,'COLLECTING THE PERTINENT LMCT (1h)' double precision, allocatable :: tmp(:,:) allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci integer :: i,j,iorb,jorb n_couples = 0 do i = 1,n_act_orb iorb = list_act(i) do j = 1, n_inact_orb jorb = list_inact(j) if(dabs(tmp(iorb,jorb)).gt.1.d-2)then n_couples +=1 hole_particle(n_couples,1) = jorb hole_particle(n_couples,2) = iorb print*,'DM' print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) endif enddo enddo deallocate(tmp) print*,'number of meaning full couples of holes/particles ' print*,'n_couples = ',n_couples end subroutine collect_mlct(hole_particle,n_couples) implicit none integer, intent(out) :: hole_particle(1000,2), n_couples BEGIN_DOC ! Collect all the couple holes/particles of the important LMCT ! hole_particle(i,1) = ith hole ! hole_particle(i,2) = ith particle ! n_couples is the number of important excitations END_DOC print*,'COLLECTING THE PERTINENT MLCT (1p)' double precision, allocatable :: tmp(:,:) allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci integer :: i,j,iorb,jorb n_couples = 0 do i = 1,n_act_orb iorb = list_act(i) do j = 1, n_virt_orb jorb = list_virt(j) if(dabs(tmp(iorb,jorb)).gt.1.d-3)then n_couples +=1 hole_particle(n_couples,1) = iorb hole_particle(n_couples,2) = jorb print*,'DM' print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) endif enddo enddo deallocate(tmp) print*,'number of meaning full couples of holes/particles ' print*,'n_couples = ',n_couples end subroutine collect_lmct_mlct(hole_particle,n_couples) implicit none integer, intent(out) :: hole_particle(1000,2), n_couples BEGIN_DOC ! Collect all the couple holes/particles of the important LMCT ! hole_particle(i,1) = ith hole ! hole_particle(i,2) = ith particle ! n_couples is the number of important excitations END_DOC double precision, allocatable :: tmp(:,:) print*,'COLLECTING THE PERTINENT LMCT (1h)' print*,'AND THE PERTINENT MLCT (1p)' allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci integer :: i,j,iorb,jorb n_couples = 0 do i = 1,n_act_orb iorb = list_act(i) do j = 1, n_inact_orb jorb = list_inact(j) if(dabs(tmp(iorb,jorb)).gt.threshold_lmct)then n_couples +=1 hole_particle(n_couples,1) = jorb hole_particle(n_couples,2) = iorb print*,'DM' print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) endif enddo do j = 1, n_virt_orb jorb = list_virt(j) if(dabs(tmp(iorb,jorb)).gt.threshold_mlct)then n_couples +=1 hole_particle(n_couples,1) = iorb hole_particle(n_couples,2) = jorb print*,'DM' print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) endif enddo enddo deallocate(tmp) print*,'number of meaning full couples of holes/particles ' print*,'n_couples = ',n_couples end subroutine collect_1h1p(hole_particle,n_couples) implicit none integer, intent(out) :: hole_particle(1000,2), n_couples BEGIN_DOC ! Collect all the couple holes/particles of the important LMCT ! hole_particle(i,1) = ith hole ! hole_particle(i,2) = ith particle ! n_couples is the number of important excitations END_DOC double precision, allocatable :: tmp(:,:) print*,'COLLECTING THE PERTINENT 1h1p' allocate(tmp(size(one_body_dm_mo_alpha_osoci,1),size(one_body_dm_mo_alpha_osoci,2))) tmp = one_body_dm_mo_alpha_osoci + one_body_dm_mo_beta_osoci integer :: i,j,iorb,jorb n_couples = 0 do i = 1,n_virt_orb iorb = list_virt(i) do j = 1, n_inact_orb jorb = list_inact(j) if(dabs(tmp(iorb,jorb)).gt.1.d-2)then n_couples +=1 hole_particle(n_couples,1) = jorb hole_particle(n_couples,2) = iorb print*,'DM' print*,hole_particle(n_couples,1),hole_particle(n_couples,2),tmp(iorb,jorb) endif enddo enddo deallocate(tmp) print*,'number of meaning full couples of holes/particles ' print*,'n_couples = ',n_couples end subroutine set_lmct_to_generators_restart implicit none integer :: i,j,m,n,i_hole,i_particle integer :: hole_particle(1000,2), n_couples integer(bit_kind) :: key_tmp(N_int,2) integer :: N_det_total,i_ok call collect_lmct(hole_particle,n_couples) call set_generators_to_generators_restart N_det_total = N_det_generators_restart do i = 1, n_couples i_hole = hole_particle(i,1) i_particle = hole_particle(i,2) do m = 1, N_det_cas do n = 1, N_int key_tmp(n,1) = psi_cas(n,1,m) key_tmp(n,2) = psi_cas(n,2,m) enddo ! You excite the beta electron from i_hole to i_particle print*,'i_hole,i_particle 2 = ',i_hole,i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) print*,'i_ok = ',i_ok if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det_generators(n,1,N_det_total) = key_tmp(n,1) psi_det_generators(n,2,N_det_total) = key_tmp(n,2) enddo endif do n = 1, N_int key_tmp(n,1) = psi_cas(n,1,m) key_tmp(n,2) = psi_cas(n,2,m) enddo ! You excite the alpha electron from i_hole to i_particle print*,'i_hole,i_particle 1 = ',i_hole,i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) print*,'i_ok = ',i_ok if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det_generators(n,1,N_det_total) = key_tmp(n,1) psi_det_generators(n,2,N_det_total) = key_tmp(n,2) enddo endif enddo enddo N_det_generators = N_det_total do i = 1, N_det_generators psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total)) enddo print*,'number of generators in total = ',N_det_generators touch N_det_generators psi_coef_generators psi_det_generators end subroutine set_mlct_to_generators_restart implicit none integer :: i,j,m,n,i_hole,i_particle integer :: hole_particle(1000,2), n_couples integer(bit_kind) :: key_tmp(N_int,2) integer :: N_det_total,i_ok call collect_mlct(hole_particle,n_couples) call set_generators_to_generators_restart N_det_total = N_det_generators_restart do i = 1, n_couples i_hole = hole_particle(i,1) i_particle = hole_particle(i,2) do m = 1, N_det_cas do n = 1, N_int key_tmp(n,1) = psi_cas(n,1,m) key_tmp(n,2) = psi_cas(n,2,m) enddo ! You excite the beta electron from i_hole to i_particle print*,'i_hole,i_particle 2 = ',i_hole,i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) print*,'i_ok = ',i_ok if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det_generators(n,1,N_det_total) = key_tmp(n,1) psi_det_generators(n,2,N_det_total) = key_tmp(n,2) enddo endif do n = 1, N_int key_tmp(n,1) = psi_cas(n,1,m) key_tmp(n,2) = psi_cas(n,2,m) enddo ! You excite the alpha electron from i_hole to i_particle print*,'i_hole,i_particle 1 = ',i_hole,i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) print*,'i_ok = ',i_ok if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det_generators(n,1,N_det_total) = key_tmp(n,1) psi_det_generators(n,2,N_det_total) = key_tmp(n,2) enddo endif enddo enddo N_det_generators = N_det_total do i = 1, N_det_generators psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total)) enddo print*,'number of generators in total = ',N_det_generators touch N_det_generators psi_coef_generators psi_det_generators end subroutine set_lmct_mlct_to_generators_restart implicit none integer :: i,j,m,n,i_hole,i_particle integer :: hole_particle(1000,2), n_couples integer(bit_kind) :: key_tmp(N_int,2) integer :: N_det_total,i_ok call collect_lmct_mlct(hole_particle,n_couples) call set_generators_to_generators_restart N_det_total = N_det_generators_restart do i = 1, n_couples i_hole = hole_particle(i,1) i_particle = hole_particle(i,2) do m = 1, N_det_cas do n = 1, N_int key_tmp(n,1) = psi_cas(n,1,m) key_tmp(n,2) = psi_cas(n,2,m) enddo ! You excite the beta electron from i_hole to i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det_generators(n,1,N_det_total) = key_tmp(n,1) psi_det_generators(n,2,N_det_total) = key_tmp(n,2) enddo endif do n = 1, N_int key_tmp(n,1) = psi_cas(n,1,m) key_tmp(n,2) = psi_cas(n,2,m) enddo ! You excite the alpha electron from i_hole to i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det_generators(n,1,N_det_total) = key_tmp(n,1) psi_det_generators(n,2,N_det_total) = key_tmp(n,2) enddo endif enddo enddo N_det_generators = N_det_total do i = 1, N_det_generators psi_coef_generators(i,1) = 1.d0/dsqrt(dble(N_det_total)) enddo print*,'number of generators in total = ',N_det_generators touch N_det_generators psi_coef_generators psi_det_generators end subroutine set_lmct_mlct_to_psi_det implicit none integer :: i,j,m,n,i_hole,i_particle integer :: hole_particle(1000,2), n_couples integer(bit_kind) :: key_tmp(N_int,2) integer :: N_det_total,i_ok call collect_lmct_mlct(hole_particle,n_couples) call set_psi_det_to_generators_restart N_det_total = N_det_generators_restart do i = 1, n_couples i_hole = hole_particle(i,1) i_particle = hole_particle(i,2) do m = 1, N_det_generators_restart do n = 1, N_int key_tmp(n,1) = psi_det_generators_restart(n,1,m) key_tmp(n,2) = psi_det_generators_restart(n,2,m) enddo ! You excite the beta electron from i_hole to i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det(n,1,N_det_total) = key_tmp(n,1) psi_det(n,2,N_det_total) = key_tmp(n,2) enddo endif do n = 1, N_int key_tmp(n,1) = psi_det_generators_restart(n,1,m) key_tmp(n,2) = psi_det_generators_restart(n,2,m) enddo ! You excite the alpha electron from i_hole to i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det(n,1,N_det_total) = key_tmp(n,1) psi_det(n,2,N_det_total) = key_tmp(n,2) enddo endif enddo enddo N_det = N_det_total integer :: k do k = 1, N_states do i = 1, N_det psi_coef(i,k) = 1.d0/dsqrt(dble(N_det_total)) enddo enddo SOFT_TOUCH N_det psi_det psi_coef logical :: found_duplicates call remove_duplicates_in_psi_det(found_duplicates) end subroutine set_1h1p_to_psi_det implicit none integer :: i,j,m,n,i_hole,i_particle integer :: hole_particle(1000,2), n_couples integer(bit_kind) :: key_tmp(N_int,2) integer :: N_det_total,i_ok call collect_1h1p(hole_particle,n_couples) call set_psi_det_to_generators_restart N_det_total = N_det_generators_restart do i = 1, n_couples i_hole = hole_particle(i,1) i_particle = hole_particle(i,2) do m = 1, N_det_generators_restart do n = 1, N_int key_tmp(n,1) = psi_det_generators_restart(n,1,m) key_tmp(n,2) = psi_det_generators_restart(n,2,m) enddo ! You excite the beta electron from i_hole to i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,2,i_ok) if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det(n,1,N_det_total) = key_tmp(n,1) psi_det(n,2,N_det_total) = key_tmp(n,2) enddo endif do n = 1, N_int key_tmp(n,1) = psi_det_generators_restart(n,1,m) key_tmp(n,2) = psi_det_generators_restart(n,2,m) enddo ! You excite the alpha electron from i_hole to i_particle call do_mono_excitation(key_tmp,i_hole,i_particle,1,i_ok) if(i_ok==1)then N_det_total +=1 do n = 1, N_int psi_det(n,1,N_det_total) = key_tmp(n,1) psi_det(n,2,N_det_total) = key_tmp(n,2) enddo endif enddo enddo N_det = N_det_total integer :: k do k = 1, N_states do i = 1, N_det psi_coef(i,k) = 1.d0/dsqrt(dble(N_det_total)) enddo enddo SOFT_TOUCH N_det psi_det psi_coef logical :: found_duplicates call remove_duplicates_in_psi_det(found_duplicates) end