9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-06 05:23:37 +01:00
qp2/src/mu_of_r/f_val_general.irp.f
2020-04-07 11:01:24 +02:00

91 lines
3.3 KiB
Fortran

BEGIN_PROVIDER [double precision, f_psi_cas_ab, (n_points_final_grid,N_states)]
&BEGIN_PROVIDER [double precision, on_top_cas_mu_r, (n_points_final_grid,N_states)]
implicit none
BEGIN_DOC
!
! Function f_{\Psi^B}(r,r) of Eq. (22) of J. Chem. Phys. 149, 194301 (2018) on each point of the grid and for all states and for a CAS wave function
!
! Assumes that the wave function in psi_det is developped within an active space defined
!
END_DOC
integer :: ipoint,istate
double precision :: wall0,wall1,r(3)
double precision :: f_ii_val_ab,two_bod_dens_ii,f_ia_val_ab,two_bod_dens_ia,f_aa_val_ab,two_bod_dens_aa
double precision :: accu
accu = 0.d0
r = 0.d0
istate = 1
! To initialize parallelization
call give_f_ii_val_ab(r,r,f_ii_val_ab,two_bod_dens_ii)
call give_f_ia_val_ab(r,r,f_ia_val_ab,two_bod_dens_ia,istate)
call give_f_aa_val_ab(r,r,f_aa_val_ab,two_bod_dens_aa,istate)
provide final_grid_points act_2_rdm_ab_mo
print*,'Providing f_psi_cas_ab..... '
call wall_time(wall0)
do istate = 1, N_states
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (ipoint,r,f_ii_val_ab,two_bod_dens_ii,f_ia_val_ab,two_bod_dens_ia,f_aa_val_ab,two_bod_dens_aa) &
!$OMP SHARED (n_points_final_grid,f_psi_cas_ab,on_top_cas_mu_r,final_grid_points,istate)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
! inactive-inactive part of f_psi(r1,r2)
call give_f_ii_val_ab(r,r,f_ii_val_ab,two_bod_dens_ii)
! inactive-active part of f_psi(r1,r2)
call give_f_ia_val_ab(r,r,f_ia_val_ab,two_bod_dens_ia,istate)
! active-active part of f_psi(r1,r2)
call give_f_aa_val_ab(r,r,f_aa_val_ab,two_bod_dens_aa,istate)
f_psi_cas_ab(ipoint,istate) = f_ii_val_ab + f_ia_val_ab + f_aa_val_ab
on_top_cas_mu_r(ipoint,istate) = two_bod_dens_ii + two_bod_dens_ia + two_bod_dens_aa
enddo
!$OMP END DO
!$OMP END PARALLEL
enddo
call wall_time(wall1)
print*,'Time to provide f_psi_cas_ab = ',wall1 - wall0
print*,'accu = ',accu
END_PROVIDER
BEGIN_PROVIDER [double precision, f_psi_hf_ab, (n_points_final_grid)]
&BEGIN_PROVIDER [double precision, on_top_hf_mu_r, (n_points_final_grid)]
implicit none
BEGIN_DOC
!
! Function f_{\Psi^B}(r,r) of Eq. (22) of J. Chem. Phys. 149, 194301 (2018) on each point of the grid for a HF wave function
!
END_DOC
integer :: ipoint
double precision :: wall0,wall1,r(3),f_HF_val_ab,two_bod_dens
f_psi_hf_ab = 0.d0
r = 0.d0
! To initialize parallelization
call f_HF_valence_ab(r,r,f_HF_val_ab,two_bod_dens)
call wall_time(wall0)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (ipoint,r,f_HF_val_ab,two_bod_dens) &
!$OMP SHARED (n_points_final_grid,f_psi_hf_ab,on_top_hf_mu_r,final_grid_points)
!$OMP DO
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points(1,ipoint)
r(2) = final_grid_points(2,ipoint)
r(3) = final_grid_points(3,ipoint)
call f_HF_valence_ab(r,r,f_HF_val_ab,two_bod_dens)
f_psi_hf_ab(ipoint) = f_HF_val_ab
on_top_hf_mu_r(ipoint) = two_bod_dens
enddo
!$OMP END DO
!$OMP END PARALLEL
call wall_time(wall1)
print*,'Time to provide f_psi_hf_ab = ',wall1 - wall0
END_PROVIDER