LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-03 09:55:59 +02:00
Code Issues Releases Wiki Activity

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

Browse Source
This commit is contained in:
Anthony Scemama 2014-09-10 15:01:26 +02:00
commit cac713584d
10 changed files with 70 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
data/ezfio_defaults
View File

@ -18,8 +18,8 @@ cis_dressed
determinants
n_states 1
n_det_max_jacobi 5000
threshold_generators 1.0
threshold_selectors 1.0
threshold_generators 0.999
threshold_selectors 0.999
read_wf False
full_ci

2
scripts/generate_h_apply.py
View File

@ -45,7 +45,7 @@ class H_apply(object):
!$OMP accu,i_a,hole_tmp,particle_tmp,occ_particle_tmp, &
!$OMP occ_hole_tmp,key_idx,i_b,j_b,key,N_elec_in_key_part_1,&
!$OMP N_elec_in_key_hole_1,N_elec_in_key_part_2, &
!$OMP N_elec_in_key_hole_2,ia_ja_pairs,iproc) &
!$OMP N_elec_in_key_hole_2,ia_ja_pairs) &
!$OMP SHARED(key_in,N_int,elec_num_tab,mo_tot_num, &
!$OMP hole_1, particl_1, hole_2, particl_2, &
!$OMP elec_alpha_num,i_generator)"""

32
src/Dets/H_apply_template.f
View File

@ -1,4 +1,4 @@
subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_generator $parameters )
subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_generator, iproc $parameters )
use omp_lib
use bitmasks
implicit none
@ -14,6 +14,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
integer(bit_kind),allocatable :: keys_out(:,:,:)
integer(bit_kind), intent(in) :: hole_1(N_int,2), particl_1(N_int,2)
integer(bit_kind), intent(in) :: hole_2(N_int,2), particl_2(N_int,2)
integer, intent(in) :: iproc
integer(bit_kind), allocatable :: hole_save(:,:)
integer(bit_kind), allocatable :: key(:,:),hole(:,:), particle(:,:)
integer(bit_kind), allocatable :: hole_tmp(:,:), particle_tmp(:,:)
@ -28,7 +29,6 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
integer, allocatable :: ia_ja_pairs(:,:,:)
integer, allocatable :: ib_jb_pairs(:,:)
double precision :: diag_H_mat_elem
integer :: iproc
integer(omp_lock_kind), save :: lck, ifirst=0
if (ifirst == 0) then
!$ call omp_init_lock(lck)
@ -37,9 +37,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
$initialization
iproc = 0
$omp_parallel
!$ iproc = omp_get_thread_num()
allocate (keys_out(N_int,2,size_max), hole_save(N_int,2), &
key(N_int,2),hole(N_int,2), particle(N_int,2), hole_tmp(N_int,2),&
particle_tmp(N_int,2), occ_particle(N_int*bit_kind_size,2), &
@ -242,7 +240,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
$finalization
end
subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters )
subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc $parameters )
use omp_lib
use bitmasks
implicit none
@ -256,6 +254,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters
integer ,intent(in) :: i_generator
integer(bit_kind),intent(in) :: key_in(N_int,2)
integer(bit_kind),intent(in) :: hole_1(N_int,2), particl_1(N_int,2)
integer, intent(in) :: iproc
integer(bit_kind),allocatable :: keys_out(:,:,:)
integer(bit_kind),allocatable :: hole_save(:,:)
integer(bit_kind),allocatable :: key(:,:),hole(:,:), particle(:,:)
@ -272,7 +271,6 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters
integer, allocatable :: ia_ja_pairs(:,:,:)
logical, allocatable :: array_pairs(:,:)
double precision :: diag_H_mat_elem
integer :: iproc
integer(omp_lock_kind), save :: lck, ifirst=0
if (ifirst == 0) then
ifirst=1
@ -281,9 +279,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters
$initialization
iproc = 0
$omp_parallel
!$ iproc = omp_get_thread_num()
allocate (keys_out(N_int,2,size_max), hole_save(N_int,2), &
key(N_int,2),hole(N_int,2), particle(N_int,2), hole_tmp(N_int,2),&
particle_tmp(N_int,2), occ_particle(N_int*bit_kind_size,2), &
@ -379,6 +375,7 @@ subroutine $subroutine($params_main)
integer(omp_lock_kind) :: lck
integer(bit_kind), allocatable :: mask(:,:,:)
integer :: ispin, k
integer :: iproc
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map N_det_selectors psi_generators
PROVIDE psi_det_sorted_bit coef_hf_selector psi_det psi_coef ref_bitmask_energy
@ -389,9 +386,10 @@ subroutine $subroutine($params_main)
!$ call omp_init_lock(lck)
IRP_IF I_LIKE_BUGS
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(i_generator,wall_2,ispin,k,mask)
!$OMP PRIVATE(i_generator,wall_2,ispin,k,mask,iproc)
iproc = 0
!$ iproc = omp_get_thread_num()
allocate( mask(N_int,2,6) )
!$OMP DO SCHEDULE(dynamic,4)
do i_generator=1,nmax
@ -428,12 +426,12 @@ IRP_IF I_LIKE_BUGS
call $subroutine_diexc(psi_generators(1,1,i_generator), &
mask(1,1,d_hole1), mask(1,1,d_part1), &
mask(1,1,d_hole2), mask(1,1,d_part2), &
i_generator $params_post)
i_generator, iproc $params_post)
endif
if($do_mono_excitations)then
call $subroutine_monoexc(psi_generators(1,1,i_generator), &
mask(1,1,s_hole ), mask(1,1,s_part ), &
i_generator $params_post)
i_generator, iproc $params_post)
endif
!$ call omp_set_lock(lck)
call wall_time(wall_2)
@ -450,13 +448,9 @@ IRP_IF I_LIKE_BUGS
!$ call omp_destroy_lock(lck)
allocate( mask(N_int,2,6) )
! do i_generator=1,N_det_generators
do i_generator=nmax+1,N_det_generators
IRP_ELSE
allocate( mask(N_int,2,6) )
do i_generator=1,N_det_generators
IRP_ENDIF
if (abort_here) then
exit
@ -490,12 +484,12 @@ IRP_ENDIF
call $subroutine_diexc(psi_generators(1,1,i_generator), &
mask(1,1,d_hole1), mask(1,1,d_part1), &
mask(1,1,d_hole2), mask(1,1,d_part2), &
i_generator $params_post)
i_generator, 0 $params_post)
endif
if($do_mono_excitations)then
call $subroutine_monoexc(psi_generators(1,1,i_generator), &
mask(1,1,s_hole ), mask(1,1,s_part ), &
i_generator $params_post)
i_generator, 0 $params_post)
endif
call wall_time(wall_2)
$printout_always

28
src/Dets/connected_to_ref.irp.f
View File

@ -1,3 +1,18 @@
integer*8 function det_search_key(det,Nint)
use bitmasks
implicit none
BEGIN_DOC
! Return an integer*8 corresponding to a determinant index for searching
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: det(Nint,2)
integer :: i
det_search_key = iand(det(1,1),det(1,2))
do i=2,Nint
det_search_key = ieor(det_search_key,iand(det(i,1),det(i,2)))
enddo
end
logical function is_in_wavefunction(key,Nint,Ndet)
implicit none
@ -12,12 +27,15 @@ logical function is_in_wavefunction(key,Nint,Ndet)
ibegin = 1
iend = N_det+1
!DIR$ FORCEINLINE
det_ref = det_search_key(key,Nint)
!DIR$ FORCEINLINE
det_search = det_search_key(psi_det_sorted_bit(1,1,1),Nint)
istep = ishft(iend-ibegin,-1)
i=ibegin+istep
do while (istep > 0)
!DIR$ FORCEINLINE
det_search = det_search_key(psi_det_sorted_bit(1,1,i),Nint)
if ( det_search > det_ref ) then
iend = i
@ -30,6 +48,7 @@ logical function is_in_wavefunction(key,Nint,Ndet)
i = ibegin + istep
end do
!DIR$ FORCEINLINE
do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref)
i = i-1
if (i == 0) then
@ -41,6 +60,7 @@ logical function is_in_wavefunction(key,Nint,Ndet)
return
endif
!DIR$ FORCEINLINE
do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref)
if ( (key(1,1) /= psi_det_sorted_bit(1,1,i)).or. &
(key(1,2) /= psi_det_sorted_bit(1,2,i)) ) then
@ -116,7 +136,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet)
N_past = max(1,N_past_in)
if (Nint == 1) then
do i=1,N_past-1
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i)))
if (degree_x2 > 4) then
@ -132,7 +152,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet)
else if (Nint==2) then
do i=1,N_past-1
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i))) + &
popcnt(xor( key(2,1), keys(2,1,i))) + &
@ -149,7 +169,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet)
else if (Nint==3) then
do i=1,N_past-1
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i))) + &
popcnt(xor( key(2,1), keys(2,1,i))) + &
@ -168,7 +188,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet)
else
do i=1,N_past-1
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i)))
!DEC$ LOOP COUNT MIN(3)

15
src/Dets/determinants.irp.f
View File

@ -292,21 +292,6 @@ END_PROVIDER
END_PROVIDER
integer*8 function det_search_key(det,Nint)
use bitmasks
implicit none
BEGIN_DOC
! Return an integer*8 corresponding to a determinant index for searching
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: det(Nint,2)
integer :: i
det_search_key = iand(det(1,1),det(1,2))
do i=2,Nint
det_search_key = ieor(det_search_key,iand(det(i,1),det(i,2)))
enddo
end
subroutine save_wavefunction
implicit none
use bitmasks

3
src/Full_CI/README.rst
View File

@ -10,6 +10,9 @@ Documentation
.. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file.
`full_ci <http://github.com/LCPQ/quantum_package/tree/master/src/Full_CI/full_ci.irp.f#L1>`_
Undocumented
Needed Modules

2
src/Full_CI/full_ci.irp.f
View File

@ -1,4 +1,4 @@
program cisd
program full_ci
implicit none
integer :: i,k

28
src/Generators_full/generators.irp.f
View File

@ -1,22 +1,16 @@
use bitmasks
BEGIN_PROVIDER [ double precision, threshold_generators ]
implicit none
BEGIN_DOC
! Percentage of the norm of the state-averaged wave function to
! consider for the generators
END_DOC
logical :: exists
PROVIDE ezfio_filename
call ezfio_has_determinants_threshold_generators(exists)
if (exists) then
call ezfio_get_determinants_threshold_generators(threshold_generators)
else
threshold_generators = 0.99d0
endif
call write_double(output_Dets,threshold_generators,'Threshold on generators')
END_PROVIDER
BEGIN_SHELL [ /usr/bin/python ]
from ezfio_with_default import EZFIO_Provider
T = EZFIO_Provider()
T.set_type ( "double precision" )
T.set_name ( "threshold_generators" )
T.set_doc ( "Percentage of the norm of the state-averaged wave function to consider for the generators" )
T.set_ezfio_dir ( "determinants" )
T.set_ezfio_name( "threshold_generators" )
T.set_output ( "output_dets" )
print T
END_SHELL
BEGIN_PROVIDER [ integer, N_det_generators ]
implicit none

7
src/Perturbation/perturbation_template.f
View File

@ -25,15 +25,16 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
ASSERT (N_st > 0)
do i = 1,buffer_size
if (is_in_wavefunction(buffer(1,1,i),Nint,N_det)) then
cycle
endif
c_ref = connected_to_ref(buffer(1,1,i),psi_generators,Nint,i_generator,N_det)
if (c_ref /= 0) then
cycle
endif
if (is_in_wavefunction(buffer(1,1,i),Nint,N_det)) then
cycle
endif
call pt2_$PERT(buffer(1,1,i), &
c_pert,e_2_pert,H_pert_diag,Nint,N_det_selectors,n_st)

27
src/Selectors_full/selectors.irp.f
View File

@ -1,21 +1,16 @@
use bitmasks
BEGIN_PROVIDER [ double precision, threshold_selectors ]
implicit none
BEGIN_DOC
! Percentage of the norm of the state-averaged wave function to
! consider for the selectors
END_DOC
logical :: exists
PROVIDE ezfio_filename
call ezfio_has_determinants_threshold_selectors(exists)
if (exists) then
call ezfio_get_determinants_threshold_selectors(threshold_selectors)
else
threshold_selectors = 0.99d0
endif
call write_double(output_Dets,threshold_selectors,'Threshold on selectors')
END_PROVIDER
BEGIN_SHELL [ /usr/bin/python ]
from ezfio_with_default import EZFIO_Provider
T = EZFIO_Provider()
T.set_type ( "double precision" )
T.set_name ( "threshold_selectors" )
T.set_doc ( "Percentage of the norm of the state-averaged wave function to consider for the selectors" )
T.set_ezfio_dir ( "determinants" )
T.set_ezfio_name( "threshold_selectors" )
T.set_output ( "output_dets" )
print T
END_SHELL
BEGIN_PROVIDER [ integer, psi_selectors_size ]
implicit none