10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-25 05:43:47 +01:00

tests if teeth can be built

This commit is contained in:
Yann Garniron 2018-09-04 14:09:51 +02:00
parent dda0dc34df
commit 9a0f900d8c

View File

@ -8,20 +8,58 @@ END_PROVIDER
&BEGIN_PROVIDER [ integer, pt2_n_tasks_max ] &BEGIN_PROVIDER [ integer, pt2_n_tasks_max ]
&BEGIN_PROVIDER [ integer, pt2_F, (N_det_generators) ] &BEGIN_PROVIDER [ integer, pt2_F, (N_det_generators) ]
implicit none implicit none
logical, external :: testTeethBuilding
pt2_F(:) = 1 pt2_F(:) = 1
!pt2_F(:N_det_generators/1000*0+50) = 1 !pt2_F(:N_det_generators/1000*0+50) = 1
pt2_n_tasks_max = 16 ! N_det_generators/100 + 1 pt2_n_tasks_max = 16 ! N_det_generators/100 + 1
if(N_det_generators < 256) then if(N_det_generators < 1024) then
pt2_minDetInFirstTeeth = 1 pt2_minDetInFirstTeeth = 1
pt2_N_teeth = 1 pt2_N_teeth = 1
else else
do pt2_N_teeth=32,1,-1
pt2_minDetInFirstTeeth = min(5, N_det_generators) pt2_minDetInFirstTeeth = min(5, N_det_generators)
pt2_N_teeth = 16 if(testTeethBuilding(pt2_minDetInFirstTeeth, pt2_N_teeth)) exit
end do
end if end if
END_PROVIDER END_PROVIDER
logical function testTeethBuilding(minF, N)
implicit none
integer, intent(in) :: minF, N
integer :: n0, i
double precision :: u0, Wt, r
double precision, allocatable :: tilde_w(:), tilde_cW(:)
integer, external :: dress_find_sample
allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators))
tilde_cW(0) = 0d0
do i=1,N_det_generators
tilde_w(i) = psi_coef_generators(i,dress_stoch_istate)**2
tilde_cW(i) = tilde_cW(i-1) + tilde_w(i)
enddo
n0 = 0
do
u0 = tilde_cW(n0)
r = tilde_cW(n0 + minF)
Wt = (1d0 - u0) / dble(N)
if(Wt >= r - u0) then
testTeethBuilding = .true.
return
end if
n0 += 1
if(N_det_generators - n0 < minF * N) then
testTeethBuilding = .false.
return
end if
end do
stop "exited testTeethBuilding"
end function
BEGIN_PROVIDER[ integer, dress_N_cp_max ] BEGIN_PROVIDER[ integer, dress_N_cp_max ]
dress_N_cp_max = 32 dress_N_cp_max = 32