added f_hf with cholesky by default

src/dft_utils_in_r/mo_in_r.irp.f

@@ -48,7 +48,7 @@
  integer :: i,j
  do i = 1, n_points_final_grid
   do j = 1, mo_num
-   mos_in_r_array_transp(i,j) = mos_in_r_array(j,i) 
+   mos_in_r_array_transp(i,j) = mos_in_r_array_omp(j,i) 
   enddo
  enddo
  END_PROVIDER

src/mu_of_r/f_cholesky.irp.f

@@ -0,0 +1,221 @@
+BEGIN_PROVIDER [integer, list_couple_orb_r1, (2,n_couple_orb_r1)]
+ implicit none
+ integer :: ii,i,mm,m,itmp
+ itmp = 0
+  do ii = 1, n_occ_val_orb_for_hf(1)
+   i = list_valence_orb_for_hf(ii,1)
+   do mm = 1, n_basis_orb ! electron 1 
+    m = list_basis(mm)
+    itmp += 1
+    list_couple_orb_r1(1,itmp) = i
+    list_couple_orb_r1(2,itmp) = m
+   enddo
+  enddo
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [integer, list_couple_orb_r2, (2,n_couple_orb_r2)]
+ implicit none
+ integer :: ii,i,mm,m,itmp
+ itmp = 0
+  do ii = 1, n_occ_val_orb_for_hf(2)
+   i = list_valence_orb_for_hf(ii,2)
+   do mm = 1, n_basis_orb ! electron 1 
+    m = list_basis(mm)
+    itmp += 1
+    list_couple_orb_r2(1,itmp) = i
+    list_couple_orb_r2(2,itmp) = m
+   enddo
+  enddo
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [integer, n_couple_orb_r1] 
+ implicit none
+ BEGIN_DOC
+ ! number of couples of alpha occupied times any basis orbital
+ END_DOC
+ n_couple_orb_r1 = n_occ_val_orb_for_hf(1) * n_basis_orb
+END_PROVIDER 
+
+BEGIN_PROVIDER [integer, n_couple_orb_r2] 
+ implicit none
+ BEGIN_DOC
+ ! number of couples of beta occupied times any basis orbital
+ END_DOC
+ n_couple_orb_r2 = n_occ_val_orb_for_hf(2) * n_basis_orb
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, mos_times_cholesky_r1, (cholesky_mo_num,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+ ! V1_AR = \sum_{I}V_AI Phi_IR where "R" specifies the index of the grid point and A the number of cholesky point
+ ! 
+ ! here Phi_IR is phi_i(R)xphi_b(R) for r1 and V_AI = (ib|A) chollesky vector
+ END_DOC
+ double precision, allocatable :: mos_ib_r1(:,:),mo_chol_r1(:,:)
+ double precision, allocatable :: test(:,:)
+ double precision :: mo_i_r1,mo_b_r1
+ integer :: ii,i,mm,m,itmp,ipoint,ll
+ allocate(mos_ib_r1(n_couple_orb_r1,n_points_final_grid))
+ allocate(mo_chol_r1(cholesky_mo_num,n_couple_orb_r1))
+
+ do ipoint = 1, n_points_final_grid
+  itmp = 0
+  do ii = 1, n_occ_val_orb_for_hf(1)
+   i = list_valence_orb_for_hf(ii,1)
+   mo_i_r1 = mos_in_r_array_omp(i,ipoint)
+   do mm = 1, n_basis_orb ! electron 1 
+    m = list_basis(mm)
+    mo_b_r1 = mos_in_r_array_omp(m,ipoint)
+    itmp += 1
+    mos_ib_r1(itmp,ipoint) = mo_i_r1 * mo_b_r1
+   enddo
+  enddo
+ enddo
+
+ itmp = 0
+ do ii = 1, n_occ_val_orb_for_hf(1)
+  i = list_valence_orb_for_hf(ii,1)
+  do mm = 1, n_basis_orb ! electron 1 
+   m = list_basis(mm)
+   itmp += 1
+   do ll = 1, cholesky_mo_num
+    mo_chol_r1(ll,itmp) = cholesky_mo_transp(ll,m,i)
+   enddo
+   enddo
+  enddo
+
+ call get_AB_prod(mo_chol_r1,cholesky_mo_num,n_couple_orb_r1,mos_ib_r1,n_points_final_grid,mos_times_cholesky_r1)
+ allocate(test(cholesky_mo_num,n_points_final_grid))
+ test = 0.d0
+ do ipoint = 1, n_points_final_grid
+  do itmp = 1, n_couple_orb_r1
+    i = list_couple_orb_r1(1,itmp)
+    m = list_couple_orb_r1(2,itmp) 
+    mo_i_r1 = mos_in_r_array_omp(i,ipoint)
+    mo_b_r1 = mos_in_r_array_omp(m,ipoint)
+    do mm = 1, cholesky_mo_num
+     test(mm,ipoint) += mo_i_r1 * mo_b_r1 * mo_chol_r1(mm,itmp)
+    enddo
+   enddo
+  enddo
+ double precision :: accu
+ accu = 0.d0
+ do ipoint = 1, n_points_final_grid
+  do mm = 1, cholesky_mo_num
+   accu += dabs(mos_times_cholesky_r1(mm,ipoint) - test(mm,ipoint) )
+   if(dabs(mos_times_cholesky_r1(mm,ipoint) - test(mm,ipoint)).gt.1.d-10)then
+    print*,'problem ! ',dabs(mos_times_cholesky_r1(mm,ipoint) - test(mm,ipoint)) & 
+                       ,     mos_times_cholesky_r1(mm,ipoint) , test(mm,ipoint) 
+   endif
+  enddo
+ enddo
+ print*,'accu = ',accu
+   
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, mos_times_cholesky_r2, (cholesky_mo_num,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+ ! V1_AR = \sum_{I}V_AI Phi_IR where "R" specifies the index of the grid point and A the number of cholesky point
+ ! 
+ ! here Phi_IR is phi_i(R)xphi_b(R) for r2 and V_AI = (ib|A) chollesky vector
+ END_DOC
+ double precision, allocatable :: mos_ib_r2(:,:),mo_chol_r2(:,:)
+ double precision, allocatable :: test(:,:)
+ double precision :: mo_i_r2,mo_b_r2
+ integer :: ii,i,mm,m,itmp,ipoint,ll
+ allocate(mos_ib_r2(n_couple_orb_r2,n_points_final_grid))
+ allocate(mo_chol_r2(cholesky_mo_num,n_couple_orb_r2))
+
+ do ipoint = 1, n_points_final_grid
+  itmp = 0
+  do ii = 1, n_occ_val_orb_for_hf(2)
+   i = list_valence_orb_for_hf(ii,2)
+   mo_i_r2 = mos_in_r_array_omp(i,ipoint)
+   do mm = 1, n_basis_orb ! electron 1 
+    m = list_basis(mm)
+    mo_b_r2 = mos_in_r_array_omp(m,ipoint)
+    itmp += 1
+    mos_ib_r2(itmp,ipoint) = mo_i_r2 * mo_b_r2
+   enddo
+  enddo
+ enddo
+
+ itmp = 0
+ do ii = 1, n_occ_val_orb_for_hf(2)
+  i = list_valence_orb_for_hf(ii,2)
+  do mm = 1, n_basis_orb ! electron 1 
+   m = list_basis(mm)
+   itmp += 1
+   do ll = 1, cholesky_mo_num
+    mo_chol_r2(ll,itmp) = cholesky_mo_transp(ll,m,i)
+   enddo
+   enddo
+  enddo
+
+ call get_AB_prod(mo_chol_r2,cholesky_mo_num,n_couple_orb_r2,mos_ib_r2,n_points_final_grid,mos_times_cholesky_r2)
+ allocate(test(cholesky_mo_num,n_points_final_grid))
+ test = 0.d0
+ do ipoint = 1, n_points_final_grid
+  do itmp = 1, n_couple_orb_r2
+    i = list_couple_orb_r2(1,itmp)
+    m = list_couple_orb_r2(2,itmp) 
+    mo_i_r2 = mos_in_r_array_omp(i,ipoint)
+    mo_b_r2 = mos_in_r_array_omp(m,ipoint)
+    do mm = 1, cholesky_mo_num
+     test(mm,ipoint) += mo_i_r2 * mo_b_r2 * mo_chol_r2(mm,itmp)
+    enddo
+   enddo
+  enddo
+ double precision :: accu
+ accu = 0.d0
+ do ipoint = 1, n_points_final_grid
+  do mm = 1, cholesky_mo_num
+   accu += dabs(mos_times_cholesky_r2(mm,ipoint) - test(mm,ipoint) )
+   if(dabs(mos_times_cholesky_r2(mm,ipoint) - test(mm,ipoint)).gt.1.d-10)then
+    print*,'problem ! ',dabs(mos_times_cholesky_r2(mm,ipoint) - test(mm,ipoint)) & 
+                       ,     mos_times_cholesky_r2(mm,ipoint) , test(mm,ipoint) 
+   endif
+  enddo
+ enddo
+ print*,'accu = ',accu
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, f_hf_cholesky, (n_points_final_grid)]
+ implicit none
+ integer :: ipoint
+ !!f(R) =  \sum_{I} \sum_{J} Phi_I(R) Phi_J(R) V_IJ
+ !!     =  \sum_{I}\sum_{J}\sum_A Phi_I(R) Phi_J(R) V_AI V_AJ
+ !!     =  \sum_A \sum_{I}Phi_I(R)V_AI \sum_{J}V_AJ Phi_J(R)
+ !!     =  \sum_A V_AR G_AR 
+ !! V_AR = \sum_{I}Phi_IR V_AI = \sum_{I}Phi^t_RI V_AI
+ double precision :: u_dot_v
+ do ipoint = 1, n_points_final_grid
+  f_hf_cholesky(ipoint) = 2.D0 * u_dot_v(mos_times_cholesky_r2(1,ipoint),mos_times_cholesky_r1(1,ipoint),cholesky_mo_num)
+ enddo
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, on_top_hf_grid, (n_points_final_grid)]
+ implicit none
+ integer :: ipoint,i,ii
+ double precision :: dm_a, dm_b
+ do ipoint = 1, n_points_final_grid
+  dm_a = 0.d0
+  do ii = 1, n_occ_val_orb_for_hf(1)
+   i = list_valence_orb_for_hf(ii,1)
+   dm_a += mos_in_r_array_omp(i,ipoint)*mos_in_r_array_omp(i,ipoint)
+  enddo
+  dm_b = 0.d0
+  do ii = 1, n_occ_val_orb_for_hf(2)
+   i = list_valence_orb_for_hf(ii,2)
+   dm_b += mos_in_r_array_omp(i,ipoint)*mos_in_r_array_omp(i,ipoint)
+  enddo
+   on_top_hf_grid(ipoint) = 2.D0 * dm_a*dm_b
+ enddo
+END_PROVIDER 
+

src/mu_of_r/mu_of_r_conditions.irp.f

@@ -61,7 +61,7 @@
  END_DOC
  integer :: ipoint
  double precision :: wall0,wall1,f_hf,on_top,w_hf,sqpi
- PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals 
+ PROVIDE f_hf_cholesky on_top_hf_grid
  print*,'providing mu_of_r_hf ...'
  call wall_time(wall0)
  sqpi = dsqrt(dacos(-1.d0))
@@ -69,10 +69,10 @@
  !$OMP PARALLEL DO &
  !$OMP DEFAULT (NONE)  &
  !$OMP PRIVATE (ipoint,f_hf,on_top,w_hf) & 
- !$OMP ShARED (n_points_final_grid,mu_of_r_hf,f_psi_hf_ab,on_top_hf_mu_r,sqpi) 
+ !$OMP ShARED (n_points_final_grid,mu_of_r_hf,f_hf_cholesky,on_top_hf_grid,sqpi) 
  do ipoint = 1, n_points_final_grid
-  f_hf   = f_psi_hf_ab(ipoint)
+  f_hf   = f_hf_cholesky(ipoint)
-  on_top = on_top_hf_mu_r(ipoint)
+  on_top = on_top_hf_grid(ipoint)
   if(on_top.le.1.d-12.or.f_hf.le.0.d0.or.f_hf * on_top.lt.0.d0)then
     w_hf   = 1.d+10
   else 
@@ -85,6 +85,44 @@
  print*,'Time to provide mu_of_r_hf = ',wall1-wall0
  END_PROVIDER 
 
+ BEGIN_PROVIDER [double precision, mu_of_r_hf_old, (n_points_final_grid) ]
+ implicit none 
+ BEGIN_DOC
+ ! mu(r) computed with a HF wave function (assumes that HF MOs are stored in the EZFIO)
+ !
+ ! corresponds to Eq. (37) of J. Chem. Phys. 149, 194301 (2018) but for \Psi^B = HF^B
+ !
+ ! !!!!!! WARNING !!!!!! if no_core_density == .True. then all contributions from the core orbitals 
+ !
+ ! in the two-body density matrix are excluded
+ END_DOC
+ integer :: ipoint
+ double precision :: wall0,wall1,f_hf,on_top,w_hf,sqpi
+ PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals 
+ print*,'providing mu_of_r_hf_old ...'
+ call wall_time(wall0)
+ sqpi = dsqrt(dacos(-1.d0))
+ provide f_psi_hf_ab 
+ !$OMP PARALLEL DO &
+ !$OMP DEFAULT (NONE)  &
+ !$OMP PRIVATE (ipoint,f_hf,on_top,w_hf) & 
+ !$OMP ShARED (n_points_final_grid,mu_of_r_hf_old,f_psi_hf_ab,on_top_hf_mu_r,sqpi) 
+ do ipoint = 1, n_points_final_grid
+  f_hf   = f_psi_hf_ab(ipoint)
+  on_top = on_top_hf_mu_r(ipoint)
+  if(on_top.le.1.d-12.or.f_hf.le.0.d0.or.f_hf * on_top.lt.0.d0)then
+    w_hf   = 1.d+10
+  else 
+    w_hf  = f_hf /  on_top
+  endif
+  mu_of_r_hf_old(ipoint) =  w_hf * sqpi * 0.5d0
+ enddo
+ !$OMP END PARALLEL DO
+ call wall_time(wall1)
+ print*,'Time to provide mu_of_r_hf_old = ',wall1-wall0
+ END_PROVIDER 
+
+
  BEGIN_PROVIDER [double precision, mu_of_r_psi_cas, (n_points_final_grid,N_states) ]
  implicit none 
  BEGIN_DOC