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 #2

Browse Source
This commit is contained in:
Thomas Applencourt 2015-04-10 18:13:06 +02:00
commit 0e9f78d51d
2 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/CAS_SD/cas_sd_selected.irp.f
View File

@ -8,6 +8,7 @@ program full_ci
N_st = N_states
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
character*(64) :: perturbation
PROVIDE N_det_cas
pt2 = 1.d0
diag_algorithm = "Lapack"
@ -59,21 +60,21 @@ program full_ci
logical :: in_cas
integer :: exc_max, degree_min
exc_max = 0
print *, 'CAS determinants : ', N_det_generators
do i=1,min(N_det_generators,10)
do k=i,N_det_generators
call get_excitation_degree(psi_det_generators(1,1,k),psi_det_generators(1,1,i),degree,N_int)
print *, 'CAS determinants : ', N_det_cas
do i=1,min(N_det_cas,10)
do k=i,N_det_cas
call get_excitation_degree(psi_cas(1,1,k),psi_cas(1,1,i),degree,N_int)
exc_max = max(exc_max,degree)
enddo
call debug_det(psi_det_generators(1,1,i),N_int)
call debug_det(psi_cas(1,1,i),N_int)
print *, ''
enddo
print *, 'Max excitation degree in the CAS :', exc_max
do i=1,N_det
in_cas = .False.
degree_min = 1000
do k=1,N_det_generators
call get_excitation_degree(psi_det_generators(1,1,k),psi_det(1,1,i),degree,N_int)
do k=1,N_det_cas
call get_excitation_degree(psi_cas(1,1,k),psi_det(1,1,i),degree,N_int)
degree_min = min(degree_min,degree)
enddo
if (degree_min > 2) then

8
src/MRCC/mrcc_utils.irp.f
View File

@ -11,8 +11,12 @@ BEGIN_PROVIDER [ double precision, lambda_mrcc, (N_states,psi_det_size) ]
size(psi_cas_coef,1), n_states, ihpsi)
double precision :: hij
do k=1,N_states
lambda_mrcc(k,i) = psi_non_cas_coef(i,k)/ihpsi(k)
lambda_mrcc(k,i) = min( lambda_mrcc (k,i),0.d0 )
if (dabs(ihpsi(k)) > 1.d-5) then
lambda_mrcc(k,i) = psi_non_cas_coef(i,k)/ihpsi(k)
lambda_mrcc(k,i) = min( lambda_mrcc (k,i),0.d0 )
else
lambda_mrcc(k,i) = 0.d0
endif
enddo
enddo
END_PROVIDER