QuantumPackage/src/some_mu_of_r/mu_rsc.irp.f

 BEGIN_PROVIDER [double precision, average_mu_rs_c     ]
&BEGIN_PROVIDER [double precision, mu_of_r_rs_c, (n_points_final_grid,N_states) ]
&BEGIN_PROVIDER [double precision, grad_mu_of_r_rs_c, (3,n_points_final_grid,N_states) ]
 implicit none
 integer :: ipoint,i,m
 include 'constants.include.F'
 double precision :: weight, rho_a_hf, rho_b_hf, rho_hf, mu_rs_c,r(3)
 average_mu_rs_c    = 0.d0
 double precision :: elec_a,elec_b,grad_mu(3)
 double precision :: dx,mu_lda, mu_tmp,mu_min,mu,damped_mu
 dx = 1.d-5
 elec_a = 0.d0
 elec_b = 0.d0
 mu_min = mu_erf
 do ipoint = 1, n_points_final_grid
  weight = final_weight_at_r_vector(ipoint)
  r(:) = final_grid_points(:,ipoint)
  rho_a_hf = one_e_dm_and_grad_alpha_in_r(4,ipoint,1)
  rho_b_hf = one_e_dm_and_grad_beta_in_r(4,ipoint,1)
  rho_hf = rho_a_hf + rho_b_hf
  rho_hf = max(rho_hf,1.D-10)
  mu_tmp = mu_rs_c(rho_hf)
  if(damped_mu_of_r)then
   mu = damped_mu(mu_tmp,mu_min)
   mu = max(mu_tmp,mu_of_r_min)
  else
   mu = mu_tmp
  endif
  if(rescaled_on_top_mu)then
   mu = mu *dsqrt(0.25d0 *  (rho_hf+rho_hf)**2/(rho_a_hf*rho_b_hf+1.d-12))
  else 
   mu=mu
  endif
  mu_of_r_rs_c(ipoint,1) = mu
  average_mu_rs_c   +=  mu_of_r_rs_c(ipoint,1) * rho_hf * weight
  elec_a += rho_a_hf * weight
  elec_b += rho_b_hf * weight

  if(damped_mu_of_r)then
   call get_grad_damped_mu_rsc(r,mu_min,dx,grad_mu) 
  else
   call get_grad_mu_rsc(r,dx,grad_mu)
  endif
  grad_mu_of_r_rs_c(:,ipoint,1) = grad_mu(:)

 enddo 
 average_mu_rs_c   = average_mu_rs_c  / dble(elec_a+ elec_b)

END_PROVIDER 



!double precision function mu_rs_c(rho)
! implicit none
! double precision, intent(in) :: rho
! include 'constants.include.F'
! double precision :: cst_rs,alpha_rs,rs
! cst_rs   = (4.d0 * dacos(-1.d0)/3.d0)**(-1.d0/3.d0)
! alpha_rs = 2.d0 * dsqrt((9.d0 * dacos(-1.d0)/4.d0)**(-1.d0/3.d0)) / sqpi
!  
! rs = cst_rs * rho**(-1.d0/3.d0)
! mu_rs_c =  alpha_rs/dsqrt(rs) 
!
!end

double precision function damped_mu_rs_c(rho,mu_min)
 implicit none
 double precision, intent(in) :: rho,mu_min
 double precision :: mu_rs_c,mu_tmp,damped_mu
 mu_tmp = mu_rs_c(rho)
 damped_mu_rs_c = damped_mu(mu_tmp, mu_min)
end

subroutine get_grad_mu_rsc(r,dx,grad_mu)
 implicit none
 double precision, intent(in) :: r(3),dx
 double precision, intent(out):: grad_mu(3)
 integer :: m
 double precision :: r_tmp(3),mu_plus, mu_minus,mu_rs_c,rho_a_hf,rho_b_hf,rho_hf
  do m = 1, 3
   r_tmp = r 
   r_tmp(m) += dx 
   call dm_dft_alpha_beta_at_r(r_tmp,rho_a_hf,rho_b_hf)
   rho_hf = rho_a_hf + rho_b_hf
   rho_hf = max(rho_hf,1.D-10)
   mu_plus = mu_rs_c(rho_hf)
   r_tmp = r 
   r_tmp(m) -= dx 
   call dm_dft_alpha_beta_at_r(r_tmp,rho_a_hf,rho_b_hf)
   rho_hf = rho_a_hf + rho_b_hf
   rho_hf = max(rho_hf,1.D-10)
   mu_minus = mu_rs_c(rho_hf)

   grad_mu(m) = (mu_plus - mu_minus)/(2.d0 * dx)
  enddo
end

subroutine get_grad_damped_mu_rsc(r,mu_min,dx,grad_mu)
 implicit none
 double precision, intent(in) :: r(3),mu_min,dx
 double precision, intent(out):: grad_mu(3)
 integer :: m
 double precision :: r_tmp(3),mu_plus, mu_minus,mu_rs_c,mu_tmp
 double precision :: rho_a_hf,rho_b_hf,rho_hf,damped_mu,rho,damped_mu_rs_c
  do m = 1, 3
   r_tmp = r 
   r_tmp(m) += dx 
   call dm_dft_alpha_beta_at_r(r_tmp,rho_a_hf,rho_b_hf)
   rho_hf = rho_a_hf + rho_b_hf
   rho_hf = max(rho_hf,1.D-10)
   mu_plus = damped_mu_rs_c(rho_hf,mu_min)

   r_tmp = r 
   r_tmp(m) -= dx 
   call dm_dft_alpha_beta_at_r(r_tmp,rho_a_hf,rho_b_hf)
   rho_hf = rho_a_hf + rho_b_hf
   rho_hf = max(rho_hf,1.D-10)
   mu_minus = damped_mu_rs_c(rho_hf,mu_min)

   grad_mu(m) = (mu_plus - mu_minus)/(2.d0 * dx)
  enddo
end


 BEGIN_PROVIDER [double precision, mu_of_r_extra_grid_rs_c, (n_points_extra_final_grid,N_states) ]
 implicit none
 integer :: ipoint,i,m
 include 'constants.include.F'
 double precision :: weight, rho_a_hf, rho_b_hf, rho_hf, mu_rs_c
 average_mu_rs_c    = 0.d0
 double precision :: elec_a,elec_b,r(3)
 double precision :: mu_tmp ,damped_mu, mu ,dx,mu_min
 dx = 1.d-5
 elec_a = 0.d0
 elec_b = 0.d0
 mu_min = mu_erf 
 do ipoint = 1, n_points_extra_final_grid
  weight = final_weight_at_r_vector_extra(ipoint)
  r(:) = final_grid_points_extra(:,ipoint)
  call dm_dft_alpha_beta_at_r(r,rho_a_hf,rho_b_hf)
  rho_hf = rho_a_hf + rho_b_hf
  rho_hf = max(rho_hf,1.D-10)
  mu_tmp = mu_rs_c(rho_hf)
  if(damped_mu_of_r)then
   mu = damped_mu(mu_tmp,mu_min)
  else
   mu = max(mu_tmp,mu_of_r_min)
  endif
  if(rescaled_on_top_mu)then
   mu = mu *dsqrt(0.25d0 *  (rho_a_hf+rho_b_hf)**2/(rho_a_hf*rho_b_hf+1.d-12))
  else 
   mu=mu
  endif
  mu_of_r_extra_grid_rs_c(ipoint,1) = mu
  elec_a += rho_a_hf * weight
  elec_b += rho_b_hf * weight
 enddo 

END_PROVIDER