mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-09-13 06:18:30 +02:00
fixed dependencies in jastrow and mu_of_r
This commit is contained in:
eginer
parent
acd2997217
commit
9a284e7fcf
157
plugins/local/non_h_ints_mu/test_mu_of_r_tc.irp.f
Normal file
157
plugins/local/non_h_ints_mu/test_mu_of_r_tc.irp.f
Normal file
@ -0,0 +1,157 @@
|
|||||||
|
program test_mu_of_r_tc
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO
|
||||||
|
END_DOC
|
||||||
|
! You specify that you want to avoid any contribution from
|
||||||
|
! orbitals coming from core
|
||||||
|
call test_grad_f_mean_field
|
||||||
|
call test_grad_mu_mf
|
||||||
|
call plot_mu_of_r_mf
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine test_grad_f_mean_field
|
||||||
|
implicit none
|
||||||
|
integer :: i_point,k
|
||||||
|
double precision :: weight,r(3)
|
||||||
|
double precision :: grad_f_mf_ab(3), grad_two_bod_dens(3)
|
||||||
|
double precision :: grad_dm_a(3), grad_dm_b(3)
|
||||||
|
double precision :: f_mf_ab,two_bod_dens, dm_a, dm_b
|
||||||
|
|
||||||
|
double precision :: num_grad_f_mf_ab(3), num_grad_two_bod_dens(3)
|
||||||
|
double precision :: num_grad_dm_a(3), num_grad_dm_b(3)
|
||||||
|
double precision :: f_mf_ab_p,f_mf_ab_m
|
||||||
|
double precision :: two_bod_dens_p, two_bod_dens_m
|
||||||
|
double precision :: dm_a_p, dm_a_m
|
||||||
|
double precision :: dm_b_p, dm_b_m
|
||||||
|
double precision :: rbis(3), dr
|
||||||
|
double precision :: accu_grad_f_mf_ab(3),accu_grad_two_bod_dens(3)
|
||||||
|
double precision :: accu_grad_dm_a(3),accu_grad_dm_b(3)
|
||||||
|
double precision :: accu_f_mf_ab, accu_two_bod_dens, accu_dm_a, accu_dm_b
|
||||||
|
dr = 0.00001d0
|
||||||
|
accu_f_mf_ab = 0.d0
|
||||||
|
accu_two_bod_dens = 0.d0
|
||||||
|
accu_dm_a = 0.d0
|
||||||
|
accu_dm_b = 0.d0
|
||||||
|
|
||||||
|
accu_grad_f_mf_ab = 0.d0
|
||||||
|
accu_grad_two_bod_dens = 0.d0
|
||||||
|
accu_grad_dm_a = 0.d0
|
||||||
|
accu_grad_dm_b = 0.d0
|
||||||
|
do i_point = 1, n_points_final_grid
|
||||||
|
r(1:3) = final_grid_points(1:3,i_point)
|
||||||
|
weight = final_weight_at_r_vector(i_point)
|
||||||
|
call get_grad_f_mf_ab(r,grad_f_mf_ab, grad_two_bod_dens,f_mf_ab,two_bod_dens, dm_a, dm_b,grad_dm_a, grad_dm_b)
|
||||||
|
call get_f_mf_ab(r,f_mf_ab_p,two_bod_dens_p, dm_a_p, dm_b_p)
|
||||||
|
accu_f_mf_ab += weight * dabs(f_mf_ab - f_mf_ab_p)
|
||||||
|
accu_two_bod_dens += weight * dabs(two_bod_dens - two_bod_dens_p)
|
||||||
|
accu_dm_a += weight*dabs(dm_a - dm_a_p)
|
||||||
|
accu_dm_b += weight*dabs(dm_b - dm_b_p)
|
||||||
|
do k = 1, 3
|
||||||
|
rbis = r
|
||||||
|
rbis(k) += dr
|
||||||
|
call get_f_mf_ab(rbis,f_mf_ab_p,two_bod_dens_p, dm_a_p, dm_b_p)
|
||||||
|
rbis = r
|
||||||
|
rbis(k) -= dr
|
||||||
|
call get_f_mf_ab(rbis,f_mf_ab_m,two_bod_dens_m, dm_a_m, dm_b_m)
|
||||||
|
num_grad_f_mf_ab(k) = (f_mf_ab_p - f_mf_ab_m)/(2.d0*dr)
|
||||||
|
num_grad_two_bod_dens(k) = (two_bod_dens_p - two_bod_dens_m)/(2.d0*dr)
|
||||||
|
num_grad_dm_a(k) = (dm_a_p - dm_a_m)/(2.d0*dr)
|
||||||
|
num_grad_dm_b(k) = (dm_b_p - dm_b_m)/(2.d0*dr)
|
||||||
|
enddo
|
||||||
|
do k = 1, 3
|
||||||
|
accu_grad_f_mf_ab(k) += weight * dabs(grad_f_mf_ab(k) - num_grad_f_mf_ab(k))
|
||||||
|
accu_grad_two_bod_dens(k) += weight * dabs(grad_two_bod_dens(k) - num_grad_two_bod_dens(k))
|
||||||
|
accu_grad_dm_a(k) += weight * dabs(grad_dm_a(k) - num_grad_dm_a(k))
|
||||||
|
accu_grad_dm_b(k) += weight * dabs(grad_dm_b(k) - num_grad_dm_b(k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'accu_f_mf_ab = ',accu_f_mf_ab
|
||||||
|
print*,'accu_two_bod_dens = ',accu_two_bod_dens
|
||||||
|
print*,'accu_dm_a = ',accu_dm_a
|
||||||
|
print*,'accu_dm_b = ',accu_dm_b
|
||||||
|
print*,'accu_grad_f_mf_ab = '
|
||||||
|
print*,accu_grad_f_mf_ab
|
||||||
|
print*,'accu_grad_two_bod_dens = '
|
||||||
|
print*,accu_grad_two_bod_dens
|
||||||
|
print*,'accu_dm_a = '
|
||||||
|
print*,accu_grad_dm_a
|
||||||
|
print*,'accu_dm_b = '
|
||||||
|
print*,accu_grad_dm_b
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine test_grad_mu_mf
|
||||||
|
implicit none
|
||||||
|
integer :: i_point,k
|
||||||
|
double precision :: weight,r(3),rbis(3)
|
||||||
|
double precision :: mu_mf, dm,grad_mu_mf(3), grad_dm(3)
|
||||||
|
double precision :: mu_mf_p, mu_mf_m, dm_m, dm_p, num_grad_mu_mf(3),dr, num_grad_dm(3)
|
||||||
|
double precision :: accu_mu, accu_dm, accu_grad_dm(3), accu_grad_mu_mf(3)
|
||||||
|
dr = 0.00001d0
|
||||||
|
accu_grad_mu_mf = 0.d0
|
||||||
|
accu_mu = 0.d0
|
||||||
|
accu_grad_dm = 0.d0
|
||||||
|
accu_dm = 0.d0
|
||||||
|
do i_point = 1, n_points_final_grid
|
||||||
|
r(1:3) = final_grid_points(1:3,i_point)
|
||||||
|
weight = final_weight_at_r_vector(i_point)
|
||||||
|
call grad_mu_of_r_mean_field(r,mu_mf, dm, grad_mu_mf, grad_dm)
|
||||||
|
call mu_of_r_mean_field(r,mu_mf_p, dm_p)
|
||||||
|
accu_mu += weight*dabs(mu_mf_p - mu_mf)
|
||||||
|
accu_dm += weight*dabs(dm_p - dm)
|
||||||
|
do k = 1, 3
|
||||||
|
rbis = r
|
||||||
|
rbis(k) += dr
|
||||||
|
call mu_of_r_mean_field(rbis,mu_mf_p, dm_p)
|
||||||
|
rbis = r
|
||||||
|
rbis(k) -= dr
|
||||||
|
call mu_of_r_mean_field(rbis,mu_mf_m, dm_m)
|
||||||
|
|
||||||
|
num_grad_mu_mf(k) = (mu_mf_p - mu_mf_m)/(2.d0*dr)
|
||||||
|
num_grad_dm(k) = (dm_p - dm_m)/(2.d0*dr)
|
||||||
|
enddo
|
||||||
|
do k = 1, 3
|
||||||
|
accu_grad_dm(k)+= weight *dabs(num_grad_dm(k) - grad_dm(k))
|
||||||
|
accu_grad_mu_mf(k)+= weight *dabs(num_grad_mu_mf(k) - grad_mu_mf(k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'accu_mu = ',accu_mu
|
||||||
|
print*,'accu_dm = ',accu_dm
|
||||||
|
print*,'accu_grad_dm = '
|
||||||
|
print*, accu_grad_dm
|
||||||
|
print*,'accu_grad_mu_mf = '
|
||||||
|
print*, accu_grad_mu_mf
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine plot_mu_of_r_mf
|
||||||
|
implicit none
|
||||||
|
include 'constants.include.F'
|
||||||
|
integer :: ipoint,npoint
|
||||||
|
double precision :: dx,r(3),xmax,xmin
|
||||||
|
double precision :: accu_mu,accu_nelec,mu_mf, dm,mu_mf_tc
|
||||||
|
character*(128) :: output
|
||||||
|
integer :: i_unit_output,getUnitAndOpen
|
||||||
|
output=trim(ezfio_filename)//'.mu_mf'
|
||||||
|
i_unit_output = getUnitAndOpen(output,'w')
|
||||||
|
xmax = 5.D0
|
||||||
|
xmin = 0.d0
|
||||||
|
npoint = 10000
|
||||||
|
dx = (xmax - xmin)/dble(npoint)
|
||||||
|
r = 0.d0
|
||||||
|
r(1) = xmin
|
||||||
|
accu_mu = 0.d0
|
||||||
|
accu_nelec = 0.d0
|
||||||
|
do ipoint = 1, npoint
|
||||||
|
call mu_of_r_mean_field(r,mu_mf, dm)
|
||||||
|
call mu_of_r_mean_field_tc(r,mu_mf_tc, dm)
|
||||||
|
write(i_unit_output,'(100(F16.10,X))')r(1),mu_mf,mu_mf_tc,dm
|
||||||
|
accu_mu += mu_mf * dm * r(1)**2*dx*4.D0*pi
|
||||||
|
accu_nelec += dm * r(1)**2*dx*4.D0*pi
|
||||||
|
r(1) += dx
|
||||||
|
enddo
|
||||||
|
print*,'nelec = ',accu_nelec
|
||||||
|
print*,'mu average = ',accu_mu/accu_nelec
|
||||||
|
end
|
||||||
@ -1,2 +1 @@
|
|||||||
cas_based_on_top
|
cas_based_on_top
|
||||||
jastrow
|
|
||||||
|
|||||||
@ -12,16 +12,12 @@ program projected_operators
|
|||||||
mu_of_r_potential = "cas_full"
|
mu_of_r_potential = "cas_full"
|
||||||
touch mu_of_r_potential
|
touch mu_of_r_potential
|
||||||
print*,'Using Valence Only functions'
|
print*,'Using Valence Only functions'
|
||||||
! call test_f_HF_valence_ab
|
call test_f_HF_valence_ab
|
||||||
! call routine_full_mos
|
call routine_full_mos
|
||||||
! call test_f_ii_valence_ab
|
call test_f_ii_valence_ab
|
||||||
! call test_f_ia_valence_ab
|
call test_f_ia_valence_ab
|
||||||
! call test_f_ii_ia_aa_valence_ab
|
call test_f_ii_ia_aa_valence_ab
|
||||||
! call test
|
call test
|
||||||
! call test_f_mean_field
|
|
||||||
call test_grad_f_mean_field
|
|
||||||
call test_grad_mu_mf
|
|
||||||
! call plot_mu_of_r_mf
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -40,168 +36,3 @@ subroutine test
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine test_f_mean_field
|
|
||||||
implicit none
|
|
||||||
integer :: i_point
|
|
||||||
double precision :: weight,r(3)
|
|
||||||
double precision :: ref_f, new_f, accu_f
|
|
||||||
double precision :: ref_two_dens, new_two_dens, accu_two_dens, dm_a, dm_b
|
|
||||||
accu_f = 0.d0
|
|
||||||
accu_two_dens = 0.d0
|
|
||||||
do i_point = 1, n_points_final_grid
|
|
||||||
r(1:3) = final_grid_points(1:3,i_point)
|
|
||||||
weight = final_weight_at_r_vector(i_point)
|
|
||||||
call get_f_mf_ab(r,new_f,new_two_dens, dm_a, dm_b)
|
|
||||||
call f_HF_valence_ab(r,r,ref_f,ref_two_dens)
|
|
||||||
accu_f += weight * dabs(new_f- ref_f)
|
|
||||||
accu_two_dens += weight * dabs(new_two_dens - ref_two_dens)
|
|
||||||
enddo
|
|
||||||
print*,'accu_f = ',accu_f
|
|
||||||
print*,'accu_two_dens = ',accu_two_dens
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine test_grad_f_mean_field
|
|
||||||
implicit none
|
|
||||||
integer :: i_point,k
|
|
||||||
double precision :: weight,r(3)
|
|
||||||
double precision :: grad_f_mf_ab(3), grad_two_bod_dens(3)
|
|
||||||
double precision :: grad_dm_a(3), grad_dm_b(3)
|
|
||||||
double precision :: f_mf_ab,two_bod_dens, dm_a, dm_b
|
|
||||||
|
|
||||||
double precision :: num_grad_f_mf_ab(3), num_grad_two_bod_dens(3)
|
|
||||||
double precision :: num_grad_dm_a(3), num_grad_dm_b(3)
|
|
||||||
double precision :: f_mf_ab_p,f_mf_ab_m
|
|
||||||
double precision :: two_bod_dens_p, two_bod_dens_m
|
|
||||||
double precision :: dm_a_p, dm_a_m
|
|
||||||
double precision :: dm_b_p, dm_b_m
|
|
||||||
double precision :: rbis(3), dr
|
|
||||||
double precision :: accu_grad_f_mf_ab(3),accu_grad_two_bod_dens(3)
|
|
||||||
double precision :: accu_grad_dm_a(3),accu_grad_dm_b(3)
|
|
||||||
double precision :: accu_f_mf_ab, accu_two_bod_dens, accu_dm_a, accu_dm_b
|
|
||||||
dr = 0.00001d0
|
|
||||||
accu_f_mf_ab = 0.d0
|
|
||||||
accu_two_bod_dens = 0.d0
|
|
||||||
accu_dm_a = 0.d0
|
|
||||||
accu_dm_b = 0.d0
|
|
||||||
|
|
||||||
accu_grad_f_mf_ab = 0.d0
|
|
||||||
accu_grad_two_bod_dens = 0.d0
|
|
||||||
accu_grad_dm_a = 0.d0
|
|
||||||
accu_grad_dm_b = 0.d0
|
|
||||||
do i_point = 1, n_points_final_grid
|
|
||||||
r(1:3) = final_grid_points(1:3,i_point)
|
|
||||||
weight = final_weight_at_r_vector(i_point)
|
|
||||||
call get_grad_f_mf_ab(r,grad_f_mf_ab, grad_two_bod_dens,f_mf_ab,two_bod_dens, dm_a, dm_b,grad_dm_a, grad_dm_b)
|
|
||||||
call get_f_mf_ab(r,f_mf_ab_p,two_bod_dens_p, dm_a_p, dm_b_p)
|
|
||||||
accu_f_mf_ab += weight * dabs(f_mf_ab - f_mf_ab_p)
|
|
||||||
accu_two_bod_dens += weight * dabs(two_bod_dens - two_bod_dens_p)
|
|
||||||
accu_dm_a += weight*dabs(dm_a - dm_a_p)
|
|
||||||
accu_dm_b += weight*dabs(dm_b - dm_b_p)
|
|
||||||
do k = 1, 3
|
|
||||||
rbis = r
|
|
||||||
rbis(k) += dr
|
|
||||||
call get_f_mf_ab(rbis,f_mf_ab_p,two_bod_dens_p, dm_a_p, dm_b_p)
|
|
||||||
rbis = r
|
|
||||||
rbis(k) -= dr
|
|
||||||
call get_f_mf_ab(rbis,f_mf_ab_m,two_bod_dens_m, dm_a_m, dm_b_m)
|
|
||||||
num_grad_f_mf_ab(k) = (f_mf_ab_p - f_mf_ab_m)/(2.d0*dr)
|
|
||||||
num_grad_two_bod_dens(k) = (two_bod_dens_p - two_bod_dens_m)/(2.d0*dr)
|
|
||||||
num_grad_dm_a(k) = (dm_a_p - dm_a_m)/(2.d0*dr)
|
|
||||||
num_grad_dm_b(k) = (dm_b_p - dm_b_m)/(2.d0*dr)
|
|
||||||
enddo
|
|
||||||
do k = 1, 3
|
|
||||||
accu_grad_f_mf_ab(k) += weight * dabs(grad_f_mf_ab(k) - num_grad_f_mf_ab(k))
|
|
||||||
accu_grad_two_bod_dens(k) += weight * dabs(grad_two_bod_dens(k) - num_grad_two_bod_dens(k))
|
|
||||||
accu_grad_dm_a(k) += weight * dabs(grad_dm_a(k) - num_grad_dm_a(k))
|
|
||||||
accu_grad_dm_b(k) += weight * dabs(grad_dm_b(k) - num_grad_dm_b(k))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
print*,'accu_f_mf_ab = ',accu_f_mf_ab
|
|
||||||
print*,'accu_two_bod_dens = ',accu_two_bod_dens
|
|
||||||
print*,'accu_dm_a = ',accu_dm_a
|
|
||||||
print*,'accu_dm_b = ',accu_dm_b
|
|
||||||
print*,'accu_grad_f_mf_ab = '
|
|
||||||
print*,accu_grad_f_mf_ab
|
|
||||||
print*,'accu_grad_two_bod_dens = '
|
|
||||||
print*,accu_grad_two_bod_dens
|
|
||||||
print*,'accu_dm_a = '
|
|
||||||
print*,accu_grad_dm_a
|
|
||||||
print*,'accu_dm_b = '
|
|
||||||
print*,accu_grad_dm_b
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine test_grad_mu_mf
|
|
||||||
implicit none
|
|
||||||
integer :: i_point,k
|
|
||||||
double precision :: weight,r(3),rbis(3)
|
|
||||||
double precision :: mu_mf, dm,grad_mu_mf(3), grad_dm(3)
|
|
||||||
double precision :: mu_mf_p, mu_mf_m, dm_m, dm_p, num_grad_mu_mf(3),dr, num_grad_dm(3)
|
|
||||||
double precision :: accu_mu, accu_dm, accu_grad_dm(3), accu_grad_mu_mf(3)
|
|
||||||
dr = 0.00001d0
|
|
||||||
accu_grad_mu_mf = 0.d0
|
|
||||||
accu_mu = 0.d0
|
|
||||||
accu_grad_dm = 0.d0
|
|
||||||
accu_dm = 0.d0
|
|
||||||
do i_point = 1, n_points_final_grid
|
|
||||||
r(1:3) = final_grid_points(1:3,i_point)
|
|
||||||
weight = final_weight_at_r_vector(i_point)
|
|
||||||
call grad_mu_of_r_mean_field(r,mu_mf, dm, grad_mu_mf, grad_dm)
|
|
||||||
call mu_of_r_mean_field(r,mu_mf_p, dm_p)
|
|
||||||
accu_mu += weight*dabs(mu_mf_p - mu_mf)
|
|
||||||
accu_dm += weight*dabs(dm_p - dm)
|
|
||||||
do k = 1, 3
|
|
||||||
rbis = r
|
|
||||||
rbis(k) += dr
|
|
||||||
call mu_of_r_mean_field(rbis,mu_mf_p, dm_p)
|
|
||||||
rbis = r
|
|
||||||
rbis(k) -= dr
|
|
||||||
call mu_of_r_mean_field(rbis,mu_mf_m, dm_m)
|
|
||||||
|
|
||||||
num_grad_mu_mf(k) = (mu_mf_p - mu_mf_m)/(2.d0*dr)
|
|
||||||
num_grad_dm(k) = (dm_p - dm_m)/(2.d0*dr)
|
|
||||||
enddo
|
|
||||||
do k = 1, 3
|
|
||||||
accu_grad_dm(k)+= weight *dabs(num_grad_dm(k) - grad_dm(k))
|
|
||||||
accu_grad_mu_mf(k)+= weight *dabs(num_grad_mu_mf(k) - grad_mu_mf(k))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
print*,'accu_mu = ',accu_mu
|
|
||||||
print*,'accu_dm = ',accu_dm
|
|
||||||
print*,'accu_grad_dm = '
|
|
||||||
print*, accu_grad_dm
|
|
||||||
print*,'accu_grad_mu_mf = '
|
|
||||||
print*, accu_grad_mu_mf
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine plot_mu_of_r_mf
|
|
||||||
implicit none
|
|
||||||
include 'constants.include.F'
|
|
||||||
integer :: ipoint,npoint
|
|
||||||
double precision :: dx,r(3),xmax,xmin
|
|
||||||
double precision :: accu_mu,accu_nelec,mu_mf, dm,mu_mf_tc
|
|
||||||
character*(128) :: output
|
|
||||||
integer :: i_unit_output,getUnitAndOpen
|
|
||||||
output=trim(ezfio_filename)//'.mu_mf'
|
|
||||||
i_unit_output = getUnitAndOpen(output,'w')
|
|
||||||
xmax = 5.D0
|
|
||||||
xmin = 0.d0
|
|
||||||
npoint = 10000
|
|
||||||
dx = (xmax - xmin)/dble(npoint)
|
|
||||||
r = 0.d0
|
|
||||||
r(1) = xmin
|
|
||||||
accu_mu = 0.d0
|
|
||||||
accu_nelec = 0.d0
|
|
||||||
do ipoint = 1, npoint
|
|
||||||
call mu_of_r_mean_field(r,mu_mf, dm)
|
|
||||||
call mu_of_r_mean_field_tc(r,mu_mf_tc, dm)
|
|
||||||
write(i_unit_output,'(100(F16.10,X))')r(1),mu_mf,mu_mf_tc,dm
|
|
||||||
accu_mu += mu_mf * dm * r(1)**2*dx*4.D0*pi
|
|
||||||
accu_nelec += dm * r(1)**2*dx*4.D0*pi
|
|
||||||
r(1) += dx
|
|
||||||
enddo
|
|
||||||
print*,'nelec = ',accu_nelec
|
|
||||||
print*,'mu average = ',accu_mu/accu_nelec
|
|
||||||
end
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user