LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-03 20:54:00 +01:00
Code Issues Releases Wiki Activity

Merge branch 'master' of github.com:scemama/quantum_package

Browse Source
This commit is contained in:
Anthony Scemama 2016-11-08 17:04:12 +01:00
commit 6ec786418a
2 changed files with 34 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
config/gfortran_debug.cfg
View File

@ -13,7 +13,7 @@
FC : gfortran -g -ffree-line-length-none -I . -static-libgcc FC : gfortran -g -ffree-line-length-none -I . -static-libgcc
LAPACK_LIB : -llapack -lblas LAPACK_LIB : -llapack -lblas
IRPF90 : irpf90 IRPF90 : irpf90
IRPF90_FLAGS : --ninja --assert --align=32 IRPF90_FLAGS : --ninja --align=32
# Global options # Global options
################ ################

36
src/Determinants/occ_pattern.irp.f
View File

@ -69,13 +69,24 @@ subroutine occ_pattern_to_dets(o,d,sze,n_alpha,Nint)
sze = nd sze = nd
integer :: ne(2), l
l=0
do i=1,nd do i=1,nd
ne(1) = 0
ne(2) = 0
l=l+1
! Doubly occupied orbitals ! Doubly occupied orbitals
do k=1,Nint do k=1,Nint
d(k,1,i) = ior(d(k,1,i),o(k,2)) d(k,1,l) = ior(d(k,1,i),o(k,2))
d(k,2,i) = ior(d(k,2,i),o(k,2)) d(k,2,l) = ior(d(k,2,i),o(k,2))
ne(1) += popcnt(d(k,1,l))
ne(2) += popcnt(d(k,2,l))
enddo enddo
if ( (ne(1) /= elec_alpha_num).or.(ne(2) /= elec_beta_num) ) then
l = l-1
endif
enddo enddo
sze = l
end end
@ -169,11 +180,11 @@ end
endif endif
j = i+1 j = i+1
do while (bit_tmp(j)==bit_tmp(i)) do while (bit_tmp(j)==bit_tmp(i))
if (duplicate(j)) then
j+=1
if (j>N_det) then if (j>N_det) then
exit exit
endif endif
if (duplicate(j)) then
j+=1
cycle cycle
endif endif
duplicate(j) = .True. duplicate(j) = .True.
@ -185,6 +196,9 @@ end
endif endif
enddo enddo
j+=1 j+=1
if (j>N_det) then
exit
endif
enddo enddo
enddo enddo
@ -256,6 +270,20 @@ subroutine make_s2_eigenfunction
det_buffer(k,1,N_det_new) = d(k,1,j) det_buffer(k,1,N_det_new) = d(k,1,j)
det_buffer(k,2,N_det_new) = d(k,2,j) det_buffer(k,2,N_det_new) = d(k,2,j)
enddo enddo
! integer :: ne(2)
! ne(:) = 0
! do k=1,N_int
! ne(1) += popcnt(d(k,1,j))
! ne(2) += popcnt(d(k,2,j))
! enddo
! if (ne(1) /= elec_alpha_num) then
! call debug_det(d(1,1,j),N_int)
! stop "ALPHA"
! endif
! if (ne(2) /= elec_beta_num) then
! call debug_det(d(1,1,j),N_int)
! stop "BETA"
! endif
if (N_det_new == bufsze) then if (N_det_new == bufsze) then
call fill_H_apply_buffer_no_selection(bufsze,det_buffer,N_int,0) call fill_H_apply_buffer_no_selection(bufsze,det_buffer,N_int,0)
N_det_new = 0 N_det_new = 0