9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-20 12:22:21 +01:00

Blanks at end of line

This commit is contained in:
Anthony Scemama 2020-02-27 10:16:27 +01:00
parent eac877dd44
commit 4741f2f544

View File

@ -13,7 +13,7 @@ END_PROVIDER
BEGIN_PROVIDER [ double precision, variance_match_weight, (N_states) ]
implicit none
BEGIN_DOC
! Weights adjusted along the selection to make the variances
! Weights adjusted along the selection to make the variances
! of each state coincide.
END_DOC
variance_match_weight(:) = 1.d0
@ -46,10 +46,10 @@ subroutine update_pt2_and_variance_weights(pt2, variance, norm, N_st)
i_iter = 1
endif
dt = 4.d0
dt = 4.d0
do k=1,N_st
rpt2(k) = pt2(k)/(1.d0 + norm(k))
rpt2(k) = pt2(k)/(1.d0 + norm(k))
enddo
avg = sum(rpt2(1:N_st)) / dble(N_st)
@ -90,7 +90,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
case (1)
print *, 'Using 1/c_max^2 weight in selection'
selection_weight(1:N_states) = c0_weight(1:N_states)
selection_weight(1:N_states) = c0_weight(1:N_states)
case (2)
print *, 'Using pt2-matching weight in selection'
@ -114,7 +114,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ]
print *, '# var weight ', real(variance_match_weight(:),4)
case (6)
print *, 'Using CI coefficient-based selection'
print *, 'Using CI coefficient-based selection'
selection_weight(1:N_states) = c0_weight(1:N_states)
case (7)
@ -289,34 +289,34 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
monoAdo = .true.
monoBdo = .true.
do k=1,N_int
hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1))
hole (k,2) = iand(psi_det_generators(k,2,i_generator), hole_mask(k,2))
particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), particle_mask(k,1))
particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), particle_mask(k,2))
enddo
integer :: N_holes(2), N_particles(2)
integer :: hole_list(N_int*bit_kind_size,2)
integer :: particle_list(N_int*bit_kind_size,2)
call bitstring_to_list_ab(hole , hole_list , N_holes , N_int)
call bitstring_to_list_ab(particle, particle_list, N_particles, N_int)
integer :: l_a, nmax, idx
integer, allocatable :: indices(:), exc_degree(:), iorder(:)
allocate (indices(N_det), &
exc_degree(max(N_det_alpha_unique,N_det_beta_unique)))
k=1
do i=1,N_det_alpha_unique
call get_excitation_degree_spin(psi_det_alpha_unique(1,i), &
psi_det_generators(1,1,i_generator), exc_degree(i), N_int)
enddo
do j=1,N_det_beta_unique
call get_excitation_degree_spin(psi_det_beta_unique(1,j), &
psi_det_generators(1,2,i_generator), nt, N_int)
@ -332,12 +332,12 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
endif
enddo
enddo
do i=1,N_det_beta_unique
call get_excitation_degree_spin(psi_det_beta_unique(1,i), &
psi_det_generators(1,2,i_generator), exc_degree(i), N_int)
enddo
do j=1,N_det_alpha_unique
call get_excitation_degree_spin(psi_det_alpha_unique(1,j), &
psi_det_generators(1,1,i_generator), nt, N_int)
@ -356,7 +356,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
endif
enddo
enddo
deallocate(exc_degree)
nmax=k-1
@ -366,18 +366,18 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
enddo
call isort(indices,iorder,nmax)
deallocate(iorder)
! Start with 32 elements. Size will double along with the filtering.
allocate(preinteresting(0:32), prefullinteresting(0:32), &
interesting(0:32), fullinteresting(0:32))
preinteresting(:) = 0
prefullinteresting(:) = 0
do i=1,N_int
negMask(i,1) = not(psi_det_generators(i,1,i_generator))
negMask(i,2) = not(psi_det_generators(i,2,i_generator))
end do
do k=1,nmax
i = indices(k)
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i))
@ -388,10 +388,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i))
nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
end do
if(nt <= 4) then
if(i <= N_det_selectors) then
sze = preinteresting(0)
sze = preinteresting(0)
if (sze+1 == size(preinteresting)) then
allocate (tmp_array(0:sze))
tmp_array(0:sze) = preinteresting(0:sze)
@ -403,7 +403,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
preinteresting(0) = sze+1
preinteresting(sze+1) = i
else if(nt <= 2) then
sze = prefullinteresting(0)
sze = prefullinteresting(0)
if (sze+1 == size(prefullinteresting)) then
allocate (tmp_array(0:sze))
tmp_array(0:sze) = prefullinteresting(0:sze)
@ -422,17 +422,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
! !$OMP CRITICAL
! print *, 'Step1: ', i_generator, preinteresting(0)
! !$OMP END CRITICAL
allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2))
allocate (mat(N_states, mo_num, mo_num))
maskInd = -1
integer :: nb_count, maskInd_save
logical :: monoBdo_save
logical :: found
do s1=1,2
do i1=N_holes(s1),1,-1 ! Generate low excitations first
found = .False.
monoBdo_save = monoBdo
maskInd_save = maskInd
@ -447,21 +447,21 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
enddo
if(s1 /= s2) monoBdo = .false.
enddo
if (.not.found) cycle
monoBdo = monoBdo_save
maskInd = maskInd_save
h1 = hole_list(i1,s1)
call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int)
negMask = not(pmask)
interesting(0) = 0
fullinteresting(0) = 0
do ii=1,preinteresting(0)
i = preinteresting(ii)
i = preinteresting(ii)
select case (N_int)
case (1)
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i))
@ -515,9 +515,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
endif
end do
end select
if(nt <= 4) then
sze = interesting(0)
sze = interesting(0)
if (sze+1 == size(interesting)) then
allocate (tmp_array(0:sze))
tmp_array(0:sze) = interesting(0:sze)
@ -529,7 +529,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
interesting(0) = sze+1
interesting(sze+1) = i
if(nt <= 2) then
sze = fullinteresting(0)
sze = fullinteresting(0)
if (sze+1 == size(fullinteresting)) then
allocate (tmp_array(0:sze))
tmp_array(0:sze) = fullinteresting(0:sze)
@ -542,9 +542,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
fullinteresting(sze+1) = i
end if
end if
end do
do ii=1,prefullinteresting(0)
i = prefullinteresting(ii)
nt = 0
@ -560,7 +560,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
end do
if(nt <= 2) then
sze = fullinteresting(0)
sze = fullinteresting(0)
if (sze+1 == size(fullinteresting)) then
allocate (tmp_array(0:sze))
tmp_array(0:sze) = fullinteresting(0:sze)
@ -577,7 +577,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
allocate (fullminilist (N_int, 2, fullinteresting(0)), &
minilist (N_int, 2, interesting(0)) )
if(pert_2rdm)then
allocate(coef_fullminilist_rev(N_states,fullinteresting(0)))
allocate(coef_fullminilist_rev(N_states,fullinteresting(0)))
do i=1,fullinteresting(0)
do j = 1, N_states
coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j)
@ -588,7 +588,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
do i=1,fullinteresting(0)
fullminilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,fullinteresting(i))
enddo
do i=1,interesting(0)
minilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,interesting(i))
enddo
@ -624,21 +624,21 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
monoAdo = .false.
end if
end if
maskInd = maskInd + 1
if(mod(maskInd, csubset) == (subset-1)) then
call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting)
if(fullMatch) cycle
! !$OMP CRITICAL
! print *, 'Step3: ', i_generator, h1, interesting(0)
! !$OMP END CRITICAL
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
if(.not.pert_2rdm)then
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf)
else
else
call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0))
endif
end if
@ -682,7 +682,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
double precision, allocatable :: values(:)
integer, allocatable :: keys(:,:)
integer :: nkeys
if(sp == 3) then
s1 = 1
@ -712,7 +712,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
! to a determinant of the future. In that case, the determinant will be
! detected as already generated when generating in the future with a
! double excitation.
!
!
! if (.not.do_singles) then
! if ((h1 == p1) .or. (h2 == p2)) then
! cycle
@ -783,6 +783,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
norm(istate) = norm(istate) + coef * coef
!!!DEBUG
! pt2(istate) = pt2(istate) - e_pert + alpha_h_psi**2/delta_E
!
! integer :: k
! double precision :: alpha_h_psi_2,hij
! alpha_h_psi_2 = 0.d0
@ -792,7 +794,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
! enddo
! if(dabs(alpha_h_psi_2 - alpha_h_psi).gt.1.d-12)then
! call debug_det(psi_det_generators(1,1,i_generator),N_int)
! call debug_det(det,N_int)
! call debug_det(det,N_int)
! print*,'alpha_h_psi,alpha_h_psi_2 = ',alpha_h_psi,alpha_h_psi_2
! stop
! endif
@ -816,7 +818,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
if(pseudo_sym)then
if(dabs(mat(1, p1, p2)).lt.thresh_sym)then
if(dabs(mat(1, p1, p2)).lt.thresh_sym)then
w = 0.d0
endif
endif
@ -857,7 +859,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
negMask(i,2) = not(mask(i,2))
end do
do i=1, N_sel
do i=1, N_sel
if (interesting(i) < 0) then
stop 'prefetch interesting(i) and det(i)'
endif
@ -1210,7 +1212,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
endif
end if
! enddo
!
!
putj = p2
! do puti=1,mo_num !HOT
if(.not. banned(putj,puti,bant)) then
@ -1573,15 +1575,15 @@ subroutine get_d0_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: mat(N_states, mo_num, mo_num)
integer, intent(in) :: h(0:2,2), p(0:4,2), sp
integer :: i, j, s, h1, h2, p1, p2, puti, putj
double precision :: hij, phase
double precision, external :: get_phase_bi, mo_two_e_integral
logical :: ok
integer :: bant
bant = 1
if(sp == 3) then ! AB
h1 = p(1,1)
@ -1619,7 +1621,7 @@ subroutine get_d0_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
end do
end do
end if
end
end
subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
use bitmasks
@ -1639,27 +1641,27 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
logical, allocatable :: lbanned(:,:)
integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j
integer :: hfix, pfix, h1, h2, p1, p2, ib
integer, parameter :: turn2(2) = (/2,1/)
integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
integer :: bant
allocate (lbanned(mo_num, 2))
lbanned = bannedOrb
do i=1, p(0,1)
lbanned(p(i,1), 1) = .true.
end do
do i=1, p(0,2)
lbanned(p(i,2), 2) = .true.
end do
ma = 1
if(p(0,2) >= 2) ma = 2
mi = turn2(ma)
bant = 1
if(sp == 3) then
@ -1682,7 +1684,7 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
tmp_row(1:N_states,putj) += hij * coefs(1:N_states)
end do
if(ma == 1) then
if(ma == 1) then
mat(1:N_states,1:mo_num,puti) += tmp_row(1:N_states,1:mo_num)
else
mat(1:N_states,puti,1:mo_num) += tmp_row(1:N_states,1:mo_num)
@ -1701,14 +1703,14 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
hij = mo_two_e_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix, N_int)
tmp_row(:,puti) += hij * coefs(:)
end if
putj = p2
if(.not. banned(putj,puti,bant)) then
hij = mo_two_e_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix, N_int)
tmp_row2(:,puti) += hij * coefs(:)
end if
end do
if(mi == 1) then
mat(:,:,p1) += tmp_row(:,:)
mat(:,:,p2) += tmp_row2(:,:)
@ -1752,7 +1754,7 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
hij = mo_two_e_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1, N_int)
tmp_row(:,puti) += hij * coefs(:)
end if
putj = p1
if(.not. banned(puti,putj,1)) then
hij = mo_two_e_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2, N_int)
@ -1788,7 +1790,7 @@ subroutine get_d1_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
mat(:, p1, p2) += coefs(:) * hij
end do
end do
end
end
subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
use bitmasks
@ -1800,30 +1802,30 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: mat(N_states, mo_num, mo_num)
integer, intent(in) :: h(0:2,2), p(0:4,2), sp
double precision, external :: get_phase_bi, mo_two_e_integral
integer :: i, j, tip, ma, mi, puti, putj
integer :: h1, h2, p1, p2, i1, i2
double precision :: hij, phase
integer, parameter:: turn2d(2,3,4) = reshape((/0,0, 0,0, 0,0, 3,4, 0,0, 0,0, 2,4, 1,4, 0,0, 2,3, 1,3, 1,2 /), (/2,3,4/))
integer, parameter :: turn2(2) = (/2, 1/)
integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
integer :: bant
bant = 1
tip = p(0,1) * p(0,2)
ma = sp
if(p(0,1) > p(0,2)) ma = 1
if(p(0,1) < p(0,2)) ma = 2
mi = mod(ma, 2) + 1
if(sp == 3) then
if(ma == 2) bant = 2
if(tip == 3) then
puti = p(1, mi)
do i = 1, 3
@ -1835,7 +1837,7 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
p2 = p(i2, ma)
h1 = h(1, ma)
h2 = h(2, ma)
hij = (mo_two_e_integral(p1, p2, h1, h2) - mo_two_e_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2, N_int)
if(ma == 1) then
mat(:, putj, puti) += coefs(:) * hij
@ -1851,10 +1853,10 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
p2 = p(turn2(j), 2)
do i = 1,2
puti = p(i, 1)
if(banned(puti,putj,bant)) cycle
p1 = p(turn2(i), 1)
hij = mo_two_e_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2,N_int)
mat(:, puti, putj) += coefs(:) * hij
end do
@ -1870,7 +1872,7 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
do j=i+1,4
putj = p(j, ma)
if(banned(puti,putj,1)) cycle
i1 = turn2d(1, i, j)
i2 = turn2d(2, i, j)
p1 = p(i1, ma)
@ -1888,7 +1890,7 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
putj = p(turn3(2,i), ma)
if(banned(puti,putj,1)) cycle
p2 = p(i, ma)
hij = mo_two_e_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2,N_int)
mat(:, min(puti, putj), max(puti, putj)) += coefs(:) * hij
end do
@ -1905,6 +1907,6 @@ subroutine get_d2_reference(gen, phasemask, bannedOrb, banned, mat, mask, h, p,
end if
end if
end if
end
end