LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-24 13:23:41 +01:00
Code Issues Releases Wiki Activity

Fixed bug in truncate_wf

Browse Source
This commit is contained in:
Anthony Scemama 2018-09-14 19:07:55 +02:00
parent b292a4e4e5
commit 5c769d531c
3 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Determinants/determinants.irp.f
View File

@ -549,23 +549,18 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
deallocate (psi_det_save)
allocate (psi_coef_save(ndet,nstates))
double precision :: accu_norm(nstates)
double precision :: accu_norm
do k=1,nstates
accu_norm = 0.d0
do k=1,nstates
do i=1,ndet
accu_norm(k) = accu_norm(k) + psicoef(i,k) * psicoef(i,k)
psi_coef_save(i,k) = psicoef(i,k)
accu_norm = accu_norm + psicoef(i,k) * psicoef(i,k)
enddo
if (accu_norm(k) == 0.d0) then
accu_norm(k) = 1.e-12
if (accu_norm == 0.d0) then
accu_norm = 1.e-12
endif
enddo
do k = 1, nstates
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
enddo
do k=1,nstates
accu_norm = 1.d0/dsqrt(accu_norm)
do i=1,ndet
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
psi_coef_save(i,k) = psicoef(i,k) * accu_norm
enddo
enddo

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

@ -256,6 +256,8 @@ BEGIN_PROVIDER [ integer, det_to_occ_pattern, (N_det) ]
integer :: i,j,k
integer(bit_kind) :: occ(N_int,2)
logical :: found
!$OMP PARALLEL DO DEFAULT(SHARED) &
!$OMP PRIVATE(i,k,j,found,occ)
do i=1,N_det
do k = 1, N_int
occ(k,1) = ieor(psi_det(k,1,i),psi_det(k,2,i))
@ -276,6 +278,7 @@ BEGIN_PROVIDER [ integer, det_to_occ_pattern, (N_det) ]
endif
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
BEGIN_PROVIDER [ double precision, weight_occ_pattern, (N_occ_pattern,N_states) ]

4
src/Determinants/truncate_wf.irp.f
View File

@ -39,7 +39,7 @@ subroutine routine
enddo
enddo
call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,N_det_max,psi_coef_tmp)
call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp)
end
@ -86,6 +86,6 @@ subroutine routine_s2
enddo
enddo
call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,N_det_max,psi_coef_tmp)
call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp)
end