mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-21 11:03:29 +01:00
merged with debug-fci-tc
Some checks reported errors
continuous-integration/drone/push Build was killed
Some checks reported errors
continuous-integration/drone/push Build was killed
This commit is contained in:
eginer
commit
db0c198788
@ -134,7 +134,6 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in)
|
||||
PROVIDE psi_det_hii selection_weight pseudo_sym
|
||||
PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max
|
||||
PROVIDE excitation_beta_max excitation_alpha_max excitation_max
|
||||
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
|
||||
|
||||
if (h0_type == 'CFG') then
|
||||
PROVIDE psi_configuration_hii det_to_configuration
|
||||
|
||||
@ -91,6 +91,7 @@ subroutine select_connected(i_generator,E0,pt2_data,b,subset,csubset)
|
||||
end subroutine select_connected
|
||||
|
||||
|
||||
|
||||
double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
@ -135,7 +136,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
|
||||
end
|
||||
|
||||
|
||||
subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,buf,subset,csubset)
|
||||
subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock_diag_tmp, E0, pt2_data, buf, subset, csubset)
|
||||
use bitmasks
|
||||
use selection_types
|
||||
implicit none
|
||||
@ -180,7 +181,6 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
|
||||
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc
|
||||
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
|
||||
|
||||
PROVIDE banned_excitation
|
||||
|
||||
@ -265,6 +265,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
enddo
|
||||
|
||||
do k = 1, nmax
|
||||
|
||||
i = indices(k)
|
||||
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted_tc(1,1,i))
|
||||
mobMask(1,2) = iand(negMask(1,2), psi_det_sorted_tc(1,2,i))
|
||||
@ -302,10 +303,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
prefullinteresting(sze+1) = i
|
||||
endif
|
||||
endif
|
||||
|
||||
enddo
|
||||
deallocate(indices)
|
||||
|
||||
|
||||
allocate( banned(mo_num, mo_num,2), bannedOrb(mo_num, 2) )
|
||||
allocate( mat(N_states, mo_num, mo_num) )
|
||||
allocate( mat_l(N_states, mo_num, mo_num), mat_r(N_states, mo_num, mo_num) )
|
||||
@ -461,11 +462,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
minilist (N_int, 2, interesting(0)) )
|
||||
|
||||
do i = 1, fullinteresting(0)
|
||||
fullminilist(:,:,i) = psi_det_sorted_tc(:,:,fullinteresting(i))
|
||||
do k = 1, N_int
|
||||
fullminilist(k,1,i) = psi_selectors(k,1,fullinteresting(i))
|
||||
fullminilist(k,2,i) = psi_selectors(k,2,fullinteresting(i))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do i = 1, interesting(0)
|
||||
minilist(:,:,i) = psi_det_sorted_tc(:,:,interesting(i))
|
||||
do k = 1, N_int
|
||||
minilist(k,1,i) = psi_selectors(k,1,interesting(i))
|
||||
minilist(k,2,i) = psi_selectors(k,2,interesting(i))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do s2 = s1, 2
|
||||
@ -508,19 +515,195 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
if(fullMatch) cycle
|
||||
|
||||
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting, mat_l, mat_r)
|
||||
|
||||
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf, mat_l, mat_r)
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
if(s1 /= s2) monoBdo = .false.
|
||||
enddo
|
||||
|
||||
deallocate(fullminilist, minilist)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(preinteresting, prefullinteresting, interesting, fullinteresting)
|
||||
deallocate(banned, bannedOrb,mat)
|
||||
deallocate(mat_l, mat_r)
|
||||
|
||||
end subroutine select_singles_and_doubles
|
||||
|
||||
! ---
|
||||
|
||||
subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting)
|
||||
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Identify the determinants in det which are in the internal space. These are
|
||||
! the determinants that can be produced by creating two particles on the mask.
|
||||
END_DOC
|
||||
|
||||
integer, intent(in) :: i_gen, N
|
||||
integer, intent(in) :: interesting(0:N)
|
||||
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N)
|
||||
logical, intent(inout) :: banned(mo_num, mo_num)
|
||||
logical, intent(out) :: fullMatch
|
||||
|
||||
integer :: i, j, na, nb, list(3)
|
||||
integer(bit_kind) :: myMask(N_int, 2), negMask(N_int, 2)
|
||||
|
||||
fullMatch = .false.
|
||||
|
||||
do i=1,N_int
|
||||
negMask(i,1) = not(mask(i,1))
|
||||
negMask(i,2) = not(mask(i,2))
|
||||
end do
|
||||
|
||||
genl : do i=1, N
|
||||
! If det(i) can't be generated by the mask, cycle
|
||||
do j=1, N_int
|
||||
if(iand(det(j,1,i), mask(j,1)) /= mask(j, 1)) cycle genl
|
||||
if(iand(det(j,2,i), mask(j,2)) /= mask(j, 2)) cycle genl
|
||||
end do
|
||||
|
||||
! If det(i) < det(i_gen), it hs already been considered
|
||||
if(interesting(i) < i_gen) then
|
||||
fullMatch = .true.
|
||||
return
|
||||
end if
|
||||
|
||||
! Identify the particles
|
||||
do j=1, N_int
|
||||
myMask(j, 1) = iand(det(j, 1, i), negMask(j, 1))
|
||||
myMask(j, 2) = iand(det(j, 2, i), negMask(j, 2))
|
||||
end do
|
||||
|
||||
call bitstring_to_list_in_selection(myMask(1,1), list(1), na, N_int)
|
||||
call bitstring_to_list_in_selection(myMask(1,2), list(na+1), nb, N_int)
|
||||
banned(list(1), list(2)) = .true.
|
||||
end do genl
|
||||
|
||||
end subroutine spot_isinwf
|
||||
|
||||
! ---
|
||||
|
||||
subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting, mat_l, mat_r)
|
||||
|
||||
BEGIN_DOC
|
||||
! Computes the contributions A(r,s) by
|
||||
! comparing the external determinant to all the internal determinants det(i).
|
||||
! an applying two particles (r,s) to the mask.
|
||||
END_DOC
|
||||
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: sp, i_gen, N_sel
|
||||
integer, intent(in) :: interesting(0:N_sel)
|
||||
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel)
|
||||
logical, intent(inout) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num, 2)
|
||||
double precision, intent(inout) :: mat(N_states, mo_num, mo_num)
|
||||
double precision, intent(inout) :: mat_l(N_states, mo_num, mo_num), mat_r(N_states, mo_num, mo_num)
|
||||
|
||||
integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt
|
||||
integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
|
||||
integer(bit_kind) :: phasemask(N_int,2)
|
||||
|
||||
|
||||
PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc
|
||||
|
||||
|
||||
mat = 0d0
|
||||
mat_l = 0d0
|
||||
mat_r = 0d0
|
||||
|
||||
do i = 1, N_int
|
||||
negMask(i,1) = not(mask(i,1))
|
||||
negMask(i,2) = not(mask(i,2))
|
||||
end do
|
||||
|
||||
! print*,'in selection '
|
||||
do i = 1, N_sel
|
||||
! call debug_det(det(1,1,i),N_int)
|
||||
! print*,i,dabs(psi_selectors_coef_transp_tc(1,2,i) * psi_selectors_coef_transp_tc(1,1,i))
|
||||
if(interesting(i) < 0) then
|
||||
stop 'prefetch interesting(i) and det(i)'
|
||||
endif
|
||||
|
||||
mobMask(1,1) = iand(negMask(1,1), det(1,1,i))
|
||||
mobMask(1,2) = iand(negMask(1,2), det(1,2,i))
|
||||
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
|
||||
|
||||
if(nt > 4) cycle
|
||||
|
||||
do j = 2, N_int
|
||||
mobMask(j,1) = iand(negMask(j,1), det(j,1,i))
|
||||
mobMask(j,2) = iand(negMask(j,2), det(j,2,i))
|
||||
nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
||||
enddo
|
||||
|
||||
if(nt > 4) cycle
|
||||
|
||||
if (interesting(i) == i_gen) then
|
||||
if(sp == 3) then
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
banned(j,k,2) = banned(k,j,1)
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
do k = 1, mo_num
|
||||
do l = k+1, mo_num
|
||||
banned(l,k,1) = banned(k,l,1)
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
|
||||
if (interesting(i) >= i_gen) then
|
||||
|
||||
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||
|
||||
perMask(1,1) = iand(mask(1,1), not(det(1,1,i)))
|
||||
perMask(1,2) = iand(mask(1,2), not(det(1,2,i)))
|
||||
do j=2,N_int
|
||||
perMask(j,1) = iand(mask(j,1), not(det(j,1,i)))
|
||||
perMask(j,2) = iand(mask(j,2), not(det(j,2,i)))
|
||||
end do
|
||||
|
||||
call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int)
|
||||
|
||||
call get_mask_phase(psi_det_sorted_tc(1,1,interesting(i)), phasemask,N_int)
|
||||
if(nt == 4) then
|
||||
call get_d2_new(det(1,1,i), phasemask, bannedOrb, banned, mat_l, mat_r, mask, h, p, sp, psi_selectors_coef_transp_tc(1, 1, interesting(i)))
|
||||
elseif(nt == 3) then
|
||||
call get_d1_new(det(1,1,i), phasemask, bannedOrb, banned, mat_l, mat_r, mask, h, p, sp, psi_selectors_coef_transp_tc(1, 1, interesting(i)))
|
||||
else
|
||||
call get_d0_new (det(1,1,i), phasemask, bannedOrb, banned, mat_l, mat_r, mask, h, p, sp, psi_selectors_coef_transp_tc(1, 1, interesting(i)))
|
||||
endif
|
||||
elseif(nt == 4) then
|
||||
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||
call past_d2(banned, p, sp)
|
||||
elseif(nt == 3) then
|
||||
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||
call past_d1(bannedOrb, p)
|
||||
endif
|
||||
enddo
|
||||
|
||||
end subroutine splash_pq
|
||||
|
||||
! ---
|
||||
|
||||
subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf, mat_l, mat_r)
|
||||
|
||||
use bitmasks
|
||||
use selection_types
|
||||
implicit none
|
||||
@ -555,6 +738,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
|
||||
|
||||
PROVIDE dominant_dets_of_cfgs N_dominant_dets_of_cfgs
|
||||
|
||||
do jstate = 1, N_states
|
||||
do istate = 1, N_states
|
||||
s_weight(istate,jstate) = dsqrt(selection_weight(istate)*selection_weight(jstate))
|
||||
@ -594,6 +778,11 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
! endif
|
||||
!endif
|
||||
|
||||
! MANU: ERREUR dans les calculs puisque < I | H | J > = 0
|
||||
! n'implique pas < I | H_TC | J > = 0 ??
|
||||
!val = maxval(abs(mat(1:N_states, p1, p2)))
|
||||
!if( val == 0d0) cycle
|
||||
|
||||
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
||||
|
||||
if(do_only_cas) then
|
||||
@ -620,7 +809,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
if(excitation_max >= 0) then
|
||||
do_cycle = .True.
|
||||
if(excitation_ref == 1) then
|
||||
call get_excitation_degree(HF_bitmask,det(1,1),degree,N_int)
|
||||
call get_excitation_degree(HF_bitmask, det(1,1), degree, N_int)
|
||||
do_cycle = do_cycle .and. (degree > excitation_max)
|
||||
elseif(excitation_ref == 2) then
|
||||
do k = 1, N_dominant_dets_of_cfgs
|
||||
@ -727,15 +916,26 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
endif
|
||||
val = 4.d0 * psi_h_alpha * alpha_h_psi
|
||||
tmp = dsqrt(delta_E * delta_E + val)
|
||||
if (delta_E < 0.d0) then
|
||||
tmp = -tmp
|
||||
endif
|
||||
e_pert(istate) = 0.5d0 * (tmp - delta_E)
|
||||
! if (delta_E < 0.d0) then
|
||||
! tmp = -tmp
|
||||
! endif
|
||||
e_pert(istate) = 0.25 * val / delta_E
|
||||
! e_pert(istate) = 0.5d0 * (tmp - delta_E)
|
||||
if(dsqrt(dabs(tmp)).gt.1.d-4.and.dabs(alpha_h_psi).gt.1.d-4)then
|
||||
coef(istate) = e_pert(istate) / alpha_h_psi
|
||||
coef(istate) = e_pert(istate) / psi_h_alpha
|
||||
else
|
||||
coef(istate) = alpha_h_psi / delta_E
|
||||
endif
|
||||
|
||||
if(selection_tc == 1)then
|
||||
if(e_pert(istate).lt.0.d0)then
|
||||
e_pert(istate)=0.d0
|
||||
else
|
||||
e_pert(istate)=-e_pert(istate)
|
||||
endif
|
||||
else if(selection_tc == -1)then
|
||||
if(e_pert(istate).gt.0.d0)e_pert(istate)=0.d0
|
||||
endif
|
||||
|
||||
! if(selection_tc == 1 )then
|
||||
! if(e_pert(istate).lt.0.d0)then
|
||||
@ -749,7 +949,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
enddo
|
||||
|
||||
|
||||
do_diag = sum(dabs(coef)) > 0.001d0 .and. N_states > 1
|
||||
|
||||
do istate = 1, N_states
|
||||
|
||||
@ -804,118 +1003,12 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
||||
|
||||
enddo ! end do p2
|
||||
enddo ! end do p1
|
||||
|
||||
end subroutine fill_buffer_double
|
||||
|
||||
! ---
|
||||
subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting, mat_l, mat_r)
|
||||
|
||||
BEGIN_DOC
|
||||
! Computes the contributions A(r,s) by
|
||||
! comparing the external determinant to all the internal determinants det(i).
|
||||
! an applying two particles (r,s) to the mask.
|
||||
END_DOC
|
||||
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: sp, i_gen, N_sel
|
||||
integer, intent(in) :: interesting(0:N_sel)
|
||||
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel)
|
||||
logical, intent(inout) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num, 2)
|
||||
double precision, intent(inout) :: mat(N_states, mo_num, mo_num)
|
||||
double precision, intent(inout) :: mat_l(N_states, mo_num, mo_num), mat_r(N_states, mo_num, mo_num)
|
||||
|
||||
integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt
|
||||
integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
|
||||
integer(bit_kind) :: phasemask(N_int,2)
|
||||
|
||||
|
||||
PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc
|
||||
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
|
||||
|
||||
|
||||
mat = 0d0
|
||||
mat_l = 0d0
|
||||
mat_r = 0d0
|
||||
|
||||
do i = 1, N_int
|
||||
negMask(i,1) = not(mask(i,1))
|
||||
negMask(i,2) = not(mask(i,2))
|
||||
end do
|
||||
|
||||
do i = 1, N_sel
|
||||
if(interesting(i) < 0) then
|
||||
stop 'prefetch interesting(i) and det(i)'
|
||||
endif
|
||||
|
||||
mobMask(1,1) = iand(negMask(1,1), det(1,1,i))
|
||||
mobMask(1,2) = iand(negMask(1,2), det(1,2,i))
|
||||
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
|
||||
|
||||
if(nt > 4) cycle
|
||||
|
||||
do j = 2, N_int
|
||||
mobMask(j,1) = iand(negMask(j,1), det(j,1,i))
|
||||
mobMask(j,2) = iand(negMask(j,2), det(j,2,i))
|
||||
nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
||||
enddo
|
||||
|
||||
if(nt > 4) cycle
|
||||
|
||||
if (interesting(i) == i_gen) then
|
||||
if(sp == 3) then
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
banned(j,k,2) = banned(k,j,1)
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
do k = 1, mo_num
|
||||
do l = k+1, mo_num
|
||||
banned(l,k,1) = banned(k,l,1)
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
|
||||
if (interesting(i) >= i_gen) then
|
||||
|
||||
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||
|
||||
perMask(1,1) = iand(mask(1,1), not(det(1,1,i)))
|
||||
perMask(1,2) = iand(mask(1,2), not(det(1,2,i)))
|
||||
do j=2,N_int
|
||||
perMask(j,1) = iand(mask(j,1), not(det(j,1,i)))
|
||||
perMask(j,2) = iand(mask(j,2), not(det(j,2,i)))
|
||||
end do
|
||||
! call get_d3_h ( det(1,1,i), bannedOrb, banned, mat , mask, p, sp, psi_selectors_coef_transp_tc (1, interesting(i)) )
|
||||
! call get_d3_htc( det(1,1,i), bannedOrb, banned, mat_r, mat_l, mask, p, sp, psi_selectors_rcoef_bi_orth_transp(1, interesting(i)) &
|
||||
! , psi_selectors_lcoef_bi_orth_transp(1, interesting(i)) )
|
||||
|
||||
call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int)
|
||||
|
||||
call get_mask_phase(psi_det_sorted_tc(1,1,interesting(i)), phasemask,N_int)
|
||||
if(nt == 4) then
|
||||
call get_d2_new(det(1,1,i), phasemask, bannedOrb, banned, mat_l, mat_r, mask, h, p, sp, psi_selectors_coef_transp_tc(1, 1, interesting(i)))
|
||||
elseif(nt == 3) then
|
||||
call get_d1_new(det(1,1,i), phasemask, bannedOrb, banned, mat_l, mat_r, mask, h, p, sp, psi_selectors_coef_transp_tc(1, 1, interesting(i)))
|
||||
else
|
||||
call get_d0_new (det(1,1,i), phasemask, bannedOrb, banned, mat_l, mat_r, mask, h, p, sp, psi_selectors_coef_transp_tc(1, 1, interesting(i)))
|
||||
endif
|
||||
elseif(nt == 4) then
|
||||
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||
call past_d2(banned, p, sp)
|
||||
elseif(nt == 3) then
|
||||
call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int)
|
||||
call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int)
|
||||
call past_d1(bannedOrb, p)
|
||||
endif
|
||||
enddo
|
||||
|
||||
end subroutine splash_pq
|
||||
! ---
|
||||
subroutine past_d1(bannedOrb, p)
|
||||
|
||||
use bitmasks
|
||||
@ -958,61 +1051,9 @@ subroutine past_d2(banned, p, sp)
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine past_d2
|
||||
|
||||
subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting)
|
||||
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Identify the determinants in det which are in the internal space. These are
|
||||
! the determinants that can be produced by creating two particles on the mask.
|
||||
END_DOC
|
||||
|
||||
integer, intent(in) :: i_gen, N
|
||||
integer, intent(in) :: interesting(0:N)
|
||||
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N)
|
||||
logical, intent(inout) :: banned(mo_num, mo_num)
|
||||
logical, intent(out) :: fullMatch
|
||||
|
||||
integer :: i, j, na, nb, list(3)
|
||||
integer(bit_kind) :: myMask(N_int, 2), negMask(N_int, 2)
|
||||
|
||||
fullMatch = .false.
|
||||
|
||||
do i=1,N_int
|
||||
negMask(i,1) = not(mask(i,1))
|
||||
negMask(i,2) = not(mask(i,2))
|
||||
end do
|
||||
|
||||
genl : do i=1, N
|
||||
! If det(i) can't be generated by the mask, cycle
|
||||
do j=1, N_int
|
||||
if(iand(det(j,1,i), mask(j,1)) /= mask(j, 1)) cycle genl
|
||||
if(iand(det(j,2,i), mask(j,2)) /= mask(j, 2)) cycle genl
|
||||
end do
|
||||
|
||||
! If det(i) < det(i_gen), it hs already been considered
|
||||
if(interesting(i) < i_gen) then
|
||||
fullMatch = .true.
|
||||
return
|
||||
end if
|
||||
|
||||
! Identify the particles
|
||||
do j=1, N_int
|
||||
myMask(j, 1) = iand(det(j, 1, i), negMask(j, 1))
|
||||
myMask(j, 2) = iand(det(j, 2, i), negMask(j, 2))
|
||||
end do
|
||||
|
||||
! call debug_det(myMask, N_int)
|
||||
call bitstring_to_list_in_selection(myMask(1,1), list(1), na, N_int)
|
||||
call bitstring_to_list_in_selection(myMask(1,2), list(na+1), nb, N_int)
|
||||
banned(list(1), list(2)) = .true.
|
||||
end do genl
|
||||
|
||||
end subroutine spot_isinwf
|
||||
|
||||
! ---
|
||||
|
||||
subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint)
|
||||
|
||||
@ -125,7 +125,11 @@ subroutine merge_selection_buffers(b1, b2)
|
||||
enddo
|
||||
b2%det => detmp
|
||||
b2%val => val
|
||||
b2%mini = min(b2%mini,b2%val(b2%N))
|
||||
! if(selection_tc == 1)then
|
||||
! b2%mini = max(b2%mini,b2%val(b2%N))
|
||||
! else
|
||||
b2%mini = min(b2%mini,b2%val(b2%N))
|
||||
! endif
|
||||
b2%cur = nmwen
|
||||
end
|
||||
|
||||
@ -157,7 +161,11 @@ subroutine sort_selection_buffer(b)
|
||||
end do
|
||||
deallocate(b%det,iorder)
|
||||
b%det => detmp
|
||||
b%mini = min(b%mini,b%val(b%N))
|
||||
! if(selection_tc == 1)then
|
||||
! b%mini = max(b%mini,b%val(b%N))
|
||||
! else
|
||||
b%mini = min(b%mini,b%val(b%N))
|
||||
! endif
|
||||
b%cur = nmwen
|
||||
end subroutine
|
||||
|
||||
|
||||
@ -17,7 +17,6 @@ end
|
||||
|
||||
subroutine provide_everything
|
||||
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
|
||||
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
|
||||
|
||||
PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context
|
||||
PROVIDE psi_det psi_coef threshold_generators state_average_weight
|
||||
@ -312,7 +311,6 @@ subroutine run_slave_main
|
||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order
|
||||
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted_tc
|
||||
PROVIDE psi_selectors_rcoef_bi_orth_transp psi_selectors_lcoef_bi_orth_transp
|
||||
|
||||
PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks
|
||||
|
||||
|
||||
@ -108,6 +108,7 @@ subroutine run_stochastic_cipsi
|
||||
ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm
|
||||
pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1))
|
||||
call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
! stop
|
||||
if (qp_stop()) exit
|
||||
enddo
|
||||
! print*,'data to extrapolate '
|
||||
|
||||
@ -18,15 +18,6 @@ BEGIN_PROVIDER [ integer, N_det_selectors]
|
||||
double precision :: norm, norm_max
|
||||
call write_time(6)
|
||||
N_det_selectors = N_det
|
||||
! norm = 1.d0
|
||||
! do i=1,N_det
|
||||
! norm = norm - psi_average_norm_contrib_tc(i)
|
||||
! if (norm - 1.d-10 < 1.d0 - threshold_selectors) then
|
||||
! N_det_selectors = i
|
||||
! exit
|
||||
! endif
|
||||
! enddo
|
||||
N_det_selectors = max(N_det_selectors,N_det_generators)
|
||||
call write_int(6,N_det_selectors,'Number of selectors')
|
||||
END_PROVIDER
|
||||
|
||||
@ -47,20 +38,11 @@ END_PROVIDER
|
||||
enddo
|
||||
do k=1,N_states
|
||||
do i=1,N_det_selectors
|
||||
psi_selectors_coef(i,k) = dsqrt(dabs(psi_l_coef_sorted_bi_ortho(i,k) * psi_r_coef_sorted_bi_ortho(i,k)))
|
||||
psi_selectors_coef(i,k) = psi_coef_sorted_tc_gen(i,k)
|
||||
psi_selectors_coef_tc(i,1,k) = psi_l_coef_sorted_bi_ortho(i,k)
|
||||
psi_selectors_coef_tc(i,2,k) = psi_r_coef_sorted_bi_ortho(i,k)
|
||||
! psi_selectors_coef_tc(i,1,k) = psi_l_coef_bi_ortho(i,k)
|
||||
! psi_selectors_coef_tc(i,2,k) = psi_r_coef_bi_ortho(i,k)
|
||||
! psi_selectors_coef_tc(i,1,k) = 1.d0
|
||||
! psi_selectors_coef_tc(i,2,k) = 1.d0
|
||||
enddo
|
||||
enddo
|
||||
print*,'selectors '
|
||||
do i = 1, N_det_selectors
|
||||
print*,i,dabs(psi_selectors_coef_tc(i,1,1)*psi_selectors_coef_tc(i,2,1))
|
||||
call debug_det(psi_selectors(1,1,i),N_int)
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -81,25 +63,6 @@ END_PROVIDER
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, psi_selectors_rcoef_bi_orth_transp, (N_states, psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_selectors_lcoef_bi_orth_transp, (N_states, psi_det_size) ]
|
||||
|
||||
implicit none
|
||||
integer :: i, k
|
||||
|
||||
psi_selectors_rcoef_bi_orth_transp = 0.d0
|
||||
psi_selectors_lcoef_bi_orth_transp = 0.d0
|
||||
|
||||
print*,'N_det,N_det_selectors',N_det,N_det_selectors
|
||||
do i = 1, N_det_selectors
|
||||
do k = 1, N_states
|
||||
psi_selectors_rcoef_bi_orth_transp(k,i) = psi_r_coef_sorted_bi_ortho(i,k)
|
||||
psi_selectors_lcoef_bi_orth_transp(k,i) = psi_l_coef_sorted_bi_ortho(i,k)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, psi_selectors_size ]
|
||||
implicit none
|
||||
psi_selectors_size = psi_det_size
|
||||
|
||||
@ -10,11 +10,8 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_tc, (psi_det_size) ]
|
||||
|
||||
psi_average_norm_contrib_tc(:) = 0.d0
|
||||
do k=1,N_states
|
||||
print*,'in psi_average_norm_contrib_tc'
|
||||
do i=1,N_det
|
||||
print*,i,dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k))
|
||||
call debug_det(psi_det(1,1,i),N_int)
|
||||
psi_average_norm_contrib_tc(i) = psi_average_norm_contrib_tc(i) + &
|
||||
psi_average_norm_contrib_tc(i) = &
|
||||
dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k))*state_average_weight(k)
|
||||
enddo
|
||||
enddo
|
||||
@ -40,29 +37,28 @@ END_PROVIDER
|
||||
! psi_r_coef_sorted_bi_ortho : right coefficients corresponding to psi_det_sorted_tc
|
||||
!
|
||||
! psi_l_coef_sorted_bi_ortho : left coefficients corresponding to psi_det_sorted_tc
|
||||
END_DOC
|
||||
END_DOC
|
||||
integer :: i,j,k
|
||||
integer, allocatable :: iorder(:)
|
||||
allocate ( iorder(N_det) )
|
||||
do i=1,N_det
|
||||
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i)
|
||||
iorder(i) = i
|
||||
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i)
|
||||
enddo
|
||||
call dsort(psi_average_norm_contrib_sorted_tc,iorder,N_det)
|
||||
do i=1,N_det
|
||||
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_sorted_tc(i)
|
||||
do j=1,N_int
|
||||
psi_det_sorted_tc(j,1,i) = psi_det(j,1,iorder(i))
|
||||
psi_det_sorted_tc(j,2,i) = psi_det(j,2,iorder(i))
|
||||
enddo
|
||||
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_sorted_tc(i)
|
||||
psi_det_sorted_tc_order(iorder(i)) = i
|
||||
psi_det_sorted_tc_order(iorder(i)) = i
|
||||
enddo
|
||||
double precision :: accu
|
||||
do k=1,N_states
|
||||
accu = 0.d0
|
||||
do i=1,N_det
|
||||
psi_coef_sorted_tc(i,k) = dsqrt(dabs(psi_l_coef_bi_ortho(iorder(i),k)*psi_r_coef_bi_ortho(iorder(i),k)))
|
||||
psi_coef_sorted_tc(i,k) = dsqrt(psi_average_norm_contrib_sorted_tc(i))
|
||||
accu += psi_coef_sorted_tc(i,k)**2
|
||||
enddo
|
||||
accu = 1.d0/dsqrt(accu)
|
||||
@ -79,14 +75,13 @@ END_PROVIDER
|
||||
psi_r_coef_sorted_bi_ortho = 0.d0
|
||||
psi_l_coef_sorted_bi_ortho = 0.d0
|
||||
do i = 1, N_det
|
||||
psi_r_coef_sorted_bi_ortho(i,1:N_states) = psi_r_coef_bi_ortho(psi_det_sorted_tc_order(i),1:N_states)
|
||||
psi_l_coef_sorted_bi_ortho(i,1:N_states) = psi_l_coef_bi_ortho(psi_det_sorted_tc_order(i),1:N_states)
|
||||
psi_r_coef_sorted_bi_ortho(i,1:N_states) = psi_r_coef_bi_ortho(iorder(i),1:N_states)
|
||||
psi_l_coef_sorted_bi_ortho(i,1:N_states) = psi_l_coef_bi_ortho(iorder(i),1:N_states)
|
||||
enddo
|
||||
deallocate(iorder)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_bit, (N_int,2,psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc_bit, (psi_det_size,N_states) ]
|
||||
implicit none
|
||||
|
||||
@ -136,15 +136,15 @@ BEGIN_PROVIDER [ double precision, psi_r_coef_bi_ortho, (psi_det_size,N_states)
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
subroutine save_tc_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psilcoef,psircoef)
|
||||
subroutine save_tc_wavefunction_general(ndet,nstates,psidet,sze,dim_psicoef,psilcoef,psircoef)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Save the wave function into the |EZFIO| file
|
||||
END_DOC
|
||||
use bitmasks
|
||||
include 'constants.include.F'
|
||||
integer, intent(in) :: ndet,nstates,dim_psicoef
|
||||
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
|
||||
integer, intent(in) :: ndet,nstates,dim_psicoef,sze
|
||||
integer(bit_kind), intent(in) :: psidet(N_int,2,sze)
|
||||
double precision, intent(in) :: psilcoef(dim_psicoef,nstates)
|
||||
double precision, intent(in) :: psircoef(dim_psicoef,nstates)
|
||||
integer*8, allocatable :: psi_det_save(:,:,:)
|
||||
@ -188,23 +188,17 @@ subroutine save_tc_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psilcoef
|
||||
call ezfio_set_tc_bi_ortho_psi_r_coef_bi_ortho(psir_coef_save)
|
||||
deallocate (psil_coef_save,psir_coef_save)
|
||||
|
||||
! allocate (psi_coef_save(ndet_qp_edit,nstates))
|
||||
! do k=1,nstates
|
||||
! do i=1,ndet_qp_edit
|
||||
! psi_coef_save(i,k) = psicoef(i,k)
|
||||
! enddo
|
||||
! enddo
|
||||
!
|
||||
! call ezfio_set_determinants_psi_coef_qp_edit(psi_coef_save)
|
||||
! deallocate (psi_coef_save)
|
||||
|
||||
call write_int(6,ndet,'Saved determinantsi and psi_r/psi_l coef')
|
||||
endif
|
||||
end
|
||||
|
||||
subroutine save_tc_bi_ortho_wavefunction
|
||||
implicit none
|
||||
call save_tc_wavefunction_general(N_det,N_states,psi_det,size(psi_l_coef_bi_ortho, 1),psi_l_coef_bi_ortho,psi_r_coef_bi_ortho)
|
||||
if(save_sorted_tc_wf)then
|
||||
call save_tc_wavefunction_general(N_det,N_states,psi_det_sorted_tc,size(psi_det_sorted_tc, 3),size(psi_l_coef_sorted_bi_ortho, 1),psi_l_coef_sorted_bi_ortho,psi_r_coef_sorted_bi_ortho)
|
||||
else
|
||||
call save_tc_wavefunction_general(N_det,N_states,psi_det,size(psi_det, 3), size(psi_l_coef_bi_ortho, 1),psi_l_coef_bi_ortho,psi_r_coef_bi_ortho)
|
||||
endif
|
||||
call routine_save_right_bi_ortho
|
||||
end
|
||||
|
||||
@ -214,9 +208,9 @@ subroutine routine_save_right_bi_ortho
|
||||
integer :: i
|
||||
allocate(coef_tmp(N_det, N_states))
|
||||
do i = 1, N_det
|
||||
coef_tmp(i,1:N_states) = psi_r_coef_bi_ortho(i,1:N_states)
|
||||
coef_tmp(i,1:N_states) = psi_r_coef_sorted_bi_ortho(i,1:N_states)
|
||||
enddo
|
||||
call save_wavefunction_general_unormalized(N_det,N_states,psi_det,size(coef_tmp,1),coef_tmp(1,1))
|
||||
call save_wavefunction_general_unormalized(N_det,N_states,psi_det_sorted_tc,size(coef_tmp,1),coef_tmp(1,1))
|
||||
end
|
||||
|
||||
subroutine routine_save_left_right_bi_ortho
|
||||
|
||||
@ -11,7 +11,7 @@ program tc_bi_ortho
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call routine_diag
|
||||
! call test
|
||||
call save_tc_bi_ortho_wavefunction
|
||||
end
|
||||
|
||||
subroutine test
|
||||
@ -19,18 +19,19 @@ subroutine test
|
||||
integer :: i,j
|
||||
double precision :: hmono,htwoe,hthree,htot
|
||||
use bitmasks
|
||||
|
||||
print*,'test'
|
||||
! call htilde_mu_mat_bi_ortho(psi_det(1,1,1), psi_det(1,1,2), N_int, hmono, htwoe, hthree, htot)
|
||||
call double_htilde_mu_mat_bi_ortho(N_int,psi_det(1,1,1), psi_det(1,1,2), hmono, htwoe, htot)
|
||||
print*,hmono, htwoe, htot
|
||||
print*,'reading the wave function '
|
||||
do i = 1, N_det
|
||||
call debug_det(psi_det(1,1,i),N_int)
|
||||
print*,i,psi_l_coef_bi_ortho(i,1)*psi_r_coef_bi_ortho(i,1)
|
||||
print*,i,psi_l_coef_bi_ortho(i,1),psi_r_coef_bi_ortho(i,1)
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
subroutine routine_diag
|
||||
implicit none
|
||||
! provide eigval_right_tc_bi_orth
|
||||
provide overlap_bi_ortho
|
||||
! provide overlap_bi_ortho
|
||||
! provide htilde_matrix_elmt_bi_ortho
|
||||
integer ::i,j
|
||||
print*,'eigval_right_tc_bi_orth = ',eigval_right_tc_bi_orth(1)
|
||||
@ -46,16 +47,7 @@ subroutine routine_diag
|
||||
print*,'e_corr_double_bi_orth = ',e_corr_double_bi_orth
|
||||
print*,'Left/right eigenvectors'
|
||||
do i = 1,N_det
|
||||
write(*,'(I5,X,(100(F12.7,X)))')i,leigvec_tc_bi_orth(i,1),reigvec_tc_bi_orth(i,1)
|
||||
write(*,'(I5,X,(100(F12.7,X)))')i,leigvec_tc_bi_orth(i,1),reigvec_tc_bi_orth(i,1),leigvec_tc_bi_orth(i,1)*reigvec_tc_bi_orth(i,1)
|
||||
enddo
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
|
||||
psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
|
||||
enddo
|
||||
enddo
|
||||
SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho
|
||||
call save_tc_bi_ortho_wavefunction
|
||||
! call routine_save_left_right_bi_ortho
|
||||
end
|
||||
|
||||
|
||||
@ -12,6 +12,25 @@
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
subroutine diagonalize_CI_tc
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Replace the coefficients of the |CI| states by the coefficients of the
|
||||
! eigenstates of the |CI| matrix.
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
|
||||
psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
|
||||
enddo
|
||||
enddo
|
||||
! psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
||||
! psi_s2(1:N_states) = CI_s2(1:N_states)
|
||||
|
||||
SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho
|
||||
end
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, eigval_right_tc_bi_orth, (N_states)]
|
||||
@ -133,10 +152,7 @@
|
||||
call bi_normalize(leigvec_tc_bi_orth,reigvec_tc_bi_orth,size(reigvec_tc_bi_orth,1),N_det,N_states)
|
||||
print*,'leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1) = ',leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1)
|
||||
norm_ground_left_right_bi_orth = 0.d0
|
||||
print*,'In diago'
|
||||
do j = 1, N_det
|
||||
print*,j,dabs(leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1))
|
||||
call debug_det(psi_det(1,1,j),N_int)
|
||||
norm_ground_left_right_bi_orth += leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1)
|
||||
enddo
|
||||
print*,'norm l/r = ',norm_ground_left_right_bi_orth
|
||||
|
||||
@ -207,3 +207,11 @@ type: logical
|
||||
doc: If |true|, only the right part of WF is used to compute spin dens
|
||||
interface: ezfio,provider,ocaml
|
||||
default: False
|
||||
|
||||
[save_sorted_tc_wf]
|
||||
type: logical
|
||||
doc: If |true|, save the bi-ortho wave functions in a sorted way
|
||||
interface: ezfio,provider,ocaml
|
||||
default: True
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user