mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-12-22 20:34:05 +01:00
99 lines
2.3 KiB
Fortran
99 lines
2.3 KiB
Fortran
program truncate_wf
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Truncate the wave function
|
|
END_DOC
|
|
read_wf = .True.
|
|
if (s2_eig) then
|
|
call routine_s2
|
|
else
|
|
call routine
|
|
endif
|
|
end
|
|
|
|
subroutine routine
|
|
implicit none
|
|
integer :: ndet_max
|
|
print*, 'Max number of determinants ?'
|
|
read(5,*) ndet_max
|
|
integer(bit_kind), allocatable :: psi_det_tmp(:,:,:)
|
|
double precision, allocatable :: psi_coef_tmp(:,:)
|
|
allocate(psi_det_tmp(N_int,2,ndet_max),psi_coef_tmp(ndet_max, N_states))
|
|
|
|
integer :: i,j
|
|
double precision :: accu(N_states)
|
|
accu = 0.d0
|
|
do i = 1, ndet_max
|
|
do j = 1, N_int
|
|
psi_det_tmp(j,1,i) = psi_det_sorted(j,1,i)
|
|
psi_det_tmp(j,2,i) = psi_det_sorted(j,2,i)
|
|
enddo
|
|
do j = 1, N_states
|
|
psi_coef_tmp(i,j) = psi_coef_sorted(i,j)
|
|
accu(j) += psi_coef_tmp(i,j) **2
|
|
enddo
|
|
enddo
|
|
do j = 1, N_states
|
|
accu(j) = 1.d0/dsqrt(accu(j))
|
|
enddo
|
|
do j = 1, N_states
|
|
do i = 1, ndet_max
|
|
psi_coef_tmp(i,j) = psi_coef_tmp(i,j) * accu(j)
|
|
enddo
|
|
enddo
|
|
|
|
call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp)
|
|
|
|
end
|
|
|
|
subroutine routine_s2
|
|
implicit none
|
|
integer :: ndet_max
|
|
double precision :: wmin
|
|
integer(bit_kind), allocatable :: psi_det_tmp(:,:,:)
|
|
double precision, allocatable :: psi_coef_tmp(:,:)
|
|
integer :: i,j,k
|
|
double precision :: accu(N_states)
|
|
|
|
print *, 'Weights of the CFG'
|
|
do i=1,N_det
|
|
print *, i, real(weight_configuration(det_to_configuration(i),:)), real(sum(weight_configuration(det_to_configuration(i),:)))
|
|
enddo
|
|
print*, 'Min weight of the configuration?'
|
|
read(5,*) wmin
|
|
|
|
ndet_max = 0
|
|
do i=1,N_det
|
|
if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle
|
|
ndet_max = ndet_max+1
|
|
enddo
|
|
|
|
allocate(psi_det_tmp(N_int,2,ndet_max),psi_coef_tmp(ndet_max, N_states))
|
|
|
|
accu = 0.d0
|
|
k=0
|
|
do i = 1, N_det
|
|
if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle
|
|
k = k+1
|
|
do j = 1, N_int
|
|
psi_det_tmp(j,1,k) = psi_det(j,1,i)
|
|
psi_det_tmp(j,2,k) = psi_det(j,2,i)
|
|
enddo
|
|
do j = 1, N_states
|
|
psi_coef_tmp(k,j) = psi_coef(i,j)
|
|
accu(j) += psi_coef_tmp(k,j)**2
|
|
enddo
|
|
enddo
|
|
do j = 1, N_states
|
|
accu(j) = 1.d0/dsqrt(accu(j))
|
|
enddo
|
|
do j = 1, N_states
|
|
do i = 1, ndet_max
|
|
psi_coef_tmp(i,j) = psi_coef_tmp(i,j) * accu(j)
|
|
enddo
|
|
enddo
|
|
|
|
call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp)
|
|
|
|
end
|