mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-26 06:01:46 +02:00
fixed conf
This commit is contained in:
commit
fd7a3c08ac
@ -40,3 +40,426 @@ END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, diag_three_elem_hf]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! < Phi_left | L | Phi_right >
|
||||
!
|
||||
!
|
||||
! if three_body_h_tc == false and noL_standard == true ==> do a normal ordering
|
||||
!
|
||||
! todo
|
||||
! this should be equivalent to
|
||||
! three_body_h_tc == true and noL_standard == false
|
||||
!
|
||||
! if three_body_h_tc == false and noL_standard == false ==> this is equal to 0
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, ipoint, mm
|
||||
double precision :: contrib, weight, four_third, one_third, two_third, exchange_int_231
|
||||
double precision :: integral_aaa, hthree, integral_aab, integral_abb, integral_bbb
|
||||
double precision, allocatable :: tmp(:)
|
||||
double precision, allocatable :: tmp_L(:,:), tmp_R(:,:)
|
||||
double precision, allocatable :: tmp_M(:,:), tmp_S(:), tmp_O(:), tmp_J(:,:)
|
||||
double precision, allocatable :: tmp_M_priv(:,:), tmp_S_priv(:), tmp_O_priv(:), tmp_J_priv(:,:)
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
if(.not. three_body_h_tc) then
|
||||
|
||||
if(noL_standard) then
|
||||
PROVIDE noL_0e
|
||||
diag_three_elem_hf = noL_0e
|
||||
else
|
||||
diag_three_elem_hf = 0.d0
|
||||
endif
|
||||
|
||||
else
|
||||
|
||||
PROVIDE int2_grad1_u12_bimo_t
|
||||
PROVIDE mos_l_in_r_array_transp
|
||||
PROVIDE mos_r_in_r_array_transp
|
||||
|
||||
if(elec_alpha_num .eq. elec_beta_num) then
|
||||
|
||||
allocate(tmp(elec_beta_num))
|
||||
allocate(tmp_L(n_points_final_grid,3), tmp_R(n_points_final_grid,3))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j, i, ipoint, tmp_L, tmp_R) &
|
||||
!$OMP SHARED(elec_beta_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, tmp, final_weight_at_r_vector)
|
||||
|
||||
!$OMP DO
|
||||
do j = 1, elec_beta_num
|
||||
|
||||
tmp_L = 0.d0
|
||||
tmp_R = 0.d0
|
||||
do i = 1, elec_beta_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_L(ipoint,1) = tmp_L(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,2) = tmp_L(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,3) = tmp_L(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
|
||||
tmp_R(ipoint,1) = tmp_R(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,2) = tmp_R(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,3) = tmp_R(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
tmp(j) = 0.d0
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp(j) = tmp(j) + final_weight_at_r_vector(ipoint) * (tmp_L(ipoint,1)*tmp_R(ipoint,1) + tmp_L(ipoint,2)*tmp_R(ipoint,2) + tmp_L(ipoint,3)*tmp_R(ipoint,3))
|
||||
enddo
|
||||
enddo ! j
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
diag_three_elem_hf = -2.d0 * sum(tmp)
|
||||
|
||||
deallocate(tmp)
|
||||
deallocate(tmp_L, tmp_R)
|
||||
|
||||
! ---
|
||||
|
||||
allocate(tmp_O(n_points_final_grid), tmp_J(n_points_final_grid,3))
|
||||
tmp_O = 0.d0
|
||||
tmp_J = 0.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i, ipoint, tmp_O_priv, tmp_J_priv) &
|
||||
!$OMP SHARED(elec_beta_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, tmp_O, tmp_J)
|
||||
|
||||
allocate(tmp_O_priv(n_points_final_grid), tmp_J_priv(n_points_final_grid,3))
|
||||
tmp_O_priv = 0.d0
|
||||
tmp_J_priv = 0.d0
|
||||
|
||||
!$OMP DO
|
||||
do i = 1, elec_beta_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp_O_priv(ipoint) = tmp_O_priv(ipoint) + mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_J_priv(ipoint,1) = tmp_J_priv(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,i,i)
|
||||
tmp_J_priv(ipoint,2) = tmp_J_priv(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,i,i)
|
||||
tmp_J_priv(ipoint,3) = tmp_J_priv(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,i,i)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP CRITICAL
|
||||
tmp_O = tmp_O + tmp_O_priv
|
||||
tmp_J = tmp_J + tmp_J_priv
|
||||
!$OMP END CRITICAL
|
||||
|
||||
deallocate(tmp_O_priv, tmp_J_priv)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
allocate(tmp_M(n_points_final_grid,3), tmp_S(n_points_final_grid))
|
||||
tmp_M = 0.d0
|
||||
tmp_S = 0.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i, j, ipoint, tmp_M_priv, tmp_S_priv) &
|
||||
!$OMP SHARED(elec_beta_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, tmp_M, tmp_S)
|
||||
|
||||
allocate(tmp_M_priv(n_points_final_grid,3), tmp_S_priv(n_points_final_grid))
|
||||
tmp_M_priv = 0.d0
|
||||
tmp_S_priv = 0.d0
|
||||
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, elec_beta_num
|
||||
do j = 1, elec_beta_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_M_priv(ipoint,1) = tmp_M_priv(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,2) = tmp_M_priv(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,3) = tmp_M_priv(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
|
||||
tmp_S_priv(ipoint) = tmp_S_priv(ipoint) + int2_grad1_u12_bimo_t(ipoint,1,i,j) * int2_grad1_u12_bimo_t(ipoint,1,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,i,j) * int2_grad1_u12_bimo_t(ipoint,2,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,i,j) * int2_grad1_u12_bimo_t(ipoint,3,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP CRITICAL
|
||||
tmp_M = tmp_M + tmp_M_priv
|
||||
tmp_S = tmp_S + tmp_S_priv
|
||||
!$OMP END CRITICAL
|
||||
|
||||
deallocate(tmp_M_priv, tmp_S_priv)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
allocate(tmp(n_points_final_grid))
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_S(ipoint) = 2.d0 * (tmp_J(ipoint,1)*tmp_J(ipoint,1) + tmp_J(ipoint,2)*tmp_J(ipoint,2) + tmp_J(ipoint,3)*tmp_J(ipoint,3)) - tmp_S(ipoint)
|
||||
|
||||
tmp(ipoint) = final_weight_at_r_vector(ipoint) * ( tmp_O(ipoint) * tmp_S(ipoint) &
|
||||
- 2.d0 * ( tmp_J(ipoint,1) * tmp_M(ipoint,1) &
|
||||
+ tmp_J(ipoint,2) * tmp_M(ipoint,2) &
|
||||
+ tmp_J(ipoint,3) * tmp_M(ipoint,3)))
|
||||
enddo
|
||||
|
||||
diag_three_elem_hf = diag_three_elem_hf -2.d0 * (sum(tmp))
|
||||
|
||||
deallocate(tmp)
|
||||
|
||||
else ! elec_alpha_num .neq. elec_beta_num
|
||||
|
||||
allocate(tmp(elec_alpha_num))
|
||||
allocate(tmp_L(n_points_final_grid,3), tmp_R(n_points_final_grid,3))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j, i, ipoint, tmp_L, tmp_R) &
|
||||
!$OMP SHARED(elec_beta_num, elec_alpha_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, tmp, final_weight_at_r_vector)
|
||||
|
||||
!$OMP DO
|
||||
do j = 1, elec_beta_num
|
||||
|
||||
tmp_L = 0.d0
|
||||
tmp_R = 0.d0
|
||||
do i = elec_beta_num+1, elec_alpha_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_L(ipoint,1) = tmp_L(ipoint,1) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,2) = tmp_L(ipoint,2) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,3) = tmp_L(ipoint,3) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
|
||||
tmp_R(ipoint,1) = tmp_R(ipoint,1) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,1,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,2) = tmp_R(ipoint,2) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,2,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,3) = tmp_R(ipoint,3) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,3,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
tmp(j) = 0.d0
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp(j) = tmp(j) + final_weight_at_r_vector(ipoint) * (tmp_L(ipoint,1)*tmp_R(ipoint,1) + tmp_L(ipoint,2)*tmp_R(ipoint,2) + tmp_L(ipoint,3)*tmp_R(ipoint,3))
|
||||
enddo
|
||||
|
||||
do i = 1, elec_beta_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_L(ipoint,1) = tmp_L(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,2) = tmp_L(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,3) = tmp_L(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
|
||||
tmp_R(ipoint,1) = tmp_R(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,2) = tmp_R(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,3) = tmp_R(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp(j) = tmp(j) + final_weight_at_r_vector(ipoint) * (tmp_L(ipoint,1)*tmp_R(ipoint,1) + tmp_L(ipoint,2)*tmp_R(ipoint,2) + tmp_L(ipoint,3)*tmp_R(ipoint,3))
|
||||
enddo
|
||||
enddo ! j
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! ---
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j, i, ipoint, tmp_L, tmp_R) &
|
||||
!$OMP SHARED(elec_beta_num, elec_alpha_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, tmp, final_weight_at_r_vector)
|
||||
|
||||
!$OMP DO
|
||||
do j = elec_beta_num+1, elec_alpha_num
|
||||
|
||||
tmp_L = 0.d0
|
||||
tmp_R = 0.d0
|
||||
do i = 1, elec_alpha_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp_L(ipoint,1) = tmp_L(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,2) = tmp_L(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
tmp_L(ipoint,3) = tmp_L(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i)
|
||||
|
||||
tmp_R(ipoint,1) = tmp_R(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,2) = tmp_R(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_R(ipoint,3) = tmp_R(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,i,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
tmp(j) = 0.d0
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp(j) = tmp(j) + 0.5d0 * final_weight_at_r_vector(ipoint) * (tmp_L(ipoint,1)*tmp_R(ipoint,1) + tmp_L(ipoint,2)*tmp_R(ipoint,2) + tmp_L(ipoint,3)*tmp_R(ipoint,3))
|
||||
enddo
|
||||
enddo ! j
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
diag_three_elem_hf = -2.d0 * sum(tmp)
|
||||
|
||||
deallocate(tmp)
|
||||
deallocate(tmp_L, tmp_R)
|
||||
|
||||
! ---
|
||||
|
||||
allocate(tmp_O(n_points_final_grid), tmp_J(n_points_final_grid,3))
|
||||
tmp_O = 0.d0
|
||||
tmp_J = 0.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i, ipoint, tmp_O_priv, tmp_J_priv) &
|
||||
!$OMP SHARED(elec_beta_num, elec_alpha_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, tmp_O, tmp_J)
|
||||
|
||||
allocate(tmp_O_priv(n_points_final_grid), tmp_J_priv(n_points_final_grid,3))
|
||||
tmp_O_priv = 0.d0
|
||||
tmp_J_priv = 0.d0
|
||||
|
||||
!$OMP DO
|
||||
do i = 1, elec_beta_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp_O_priv(ipoint) = tmp_O_priv(ipoint) + mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_J_priv(ipoint,1) = tmp_J_priv(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,i,i)
|
||||
tmp_J_priv(ipoint,2) = tmp_J_priv(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,i,i)
|
||||
tmp_J_priv(ipoint,3) = tmp_J_priv(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,i,i)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP DO
|
||||
do i = elec_beta_num+1, elec_alpha_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp_O_priv(ipoint) = tmp_O_priv(ipoint) + 0.5d0 * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_J_priv(ipoint,1) = tmp_J_priv(ipoint,1) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,1,i,i)
|
||||
tmp_J_priv(ipoint,2) = tmp_J_priv(ipoint,2) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,2,i,i)
|
||||
tmp_J_priv(ipoint,3) = tmp_J_priv(ipoint,3) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,3,i,i)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP CRITICAL
|
||||
tmp_O = tmp_O + tmp_O_priv
|
||||
tmp_J = tmp_J + tmp_J_priv
|
||||
!$OMP END CRITICAL
|
||||
|
||||
deallocate(tmp_O_priv, tmp_J_priv)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! ---
|
||||
|
||||
allocate(tmp_M(n_points_final_grid,3), tmp_S(n_points_final_grid))
|
||||
tmp_M = 0.d0
|
||||
tmp_S = 0.d0
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i, j, ipoint, tmp_M_priv, tmp_S_priv) &
|
||||
!$OMP SHARED(elec_beta_num, elec_alpha_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, tmp_M, tmp_S)
|
||||
|
||||
allocate(tmp_M_priv(n_points_final_grid,3), tmp_S_priv(n_points_final_grid))
|
||||
tmp_M_priv = 0.d0
|
||||
tmp_S_priv = 0.d0
|
||||
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, elec_beta_num
|
||||
do j = 1, elec_beta_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_M_priv(ipoint,1) = tmp_M_priv(ipoint,1) + int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,2) = tmp_M_priv(ipoint,2) + int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,3) = tmp_M_priv(ipoint,3) + int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
|
||||
tmp_S_priv(ipoint) = tmp_S_priv(ipoint) + int2_grad1_u12_bimo_t(ipoint,1,i,j) * int2_grad1_u12_bimo_t(ipoint,1,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,i,j) * int2_grad1_u12_bimo_t(ipoint,2,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,i,j) * int2_grad1_u12_bimo_t(ipoint,3,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = elec_beta_num+1, elec_alpha_num
|
||||
do j = 1, elec_beta_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_M_priv(ipoint,1) = tmp_M_priv(ipoint,1) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,2) = tmp_M_priv(ipoint,2) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,3) = tmp_M_priv(ipoint,3) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
|
||||
tmp_M_priv(ipoint,1) = tmp_M_priv(ipoint,1) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,1,i,j) * mos_l_in_r_array_transp(ipoint,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_M_priv(ipoint,2) = tmp_M_priv(ipoint,2) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,2,i,j) * mos_l_in_r_array_transp(ipoint,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp_M_priv(ipoint,3) = tmp_M_priv(ipoint,3) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,3,i,j) * mos_l_in_r_array_transp(ipoint,j) * mos_r_in_r_array_transp(ipoint,i)
|
||||
|
||||
tmp_S_priv(ipoint) = tmp_S_priv(ipoint) + int2_grad1_u12_bimo_t(ipoint,1,i,j) * int2_grad1_u12_bimo_t(ipoint,1,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,i,j) * int2_grad1_u12_bimo_t(ipoint,2,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,i,j) * int2_grad1_u12_bimo_t(ipoint,3,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = elec_beta_num+1, elec_alpha_num
|
||||
do j = elec_beta_num+1, elec_alpha_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_M_priv(ipoint,1) = tmp_M_priv(ipoint,1) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,1,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,2) = tmp_M_priv(ipoint,2) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,2,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
tmp_M_priv(ipoint,3) = tmp_M_priv(ipoint,3) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,3,j,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,j)
|
||||
|
||||
tmp_S_priv(ipoint) = tmp_S_priv(ipoint) + 0.5d0 * int2_grad1_u12_bimo_t(ipoint,1,i,j) * int2_grad1_u12_bimo_t(ipoint,1,j,i) &
|
||||
+ 0.5d0 * int2_grad1_u12_bimo_t(ipoint,2,i,j) * int2_grad1_u12_bimo_t(ipoint,2,j,i) &
|
||||
+ 0.5d0 * int2_grad1_u12_bimo_t(ipoint,3,i,j) * int2_grad1_u12_bimo_t(ipoint,3,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP CRITICAL
|
||||
tmp_M = tmp_M + tmp_M_priv
|
||||
tmp_S = tmp_S + tmp_S_priv
|
||||
!$OMP END CRITICAL
|
||||
|
||||
deallocate(tmp_M_priv, tmp_S_priv)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
allocate(tmp(n_points_final_grid))
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp_S(ipoint) = 2.d0 * (tmp_J(ipoint,1)*tmp_J(ipoint,1) + tmp_J(ipoint,2)*tmp_J(ipoint,2) + tmp_J(ipoint,3)*tmp_J(ipoint,3)) - tmp_S(ipoint)
|
||||
|
||||
tmp(ipoint) = final_weight_at_r_vector(ipoint) * ( tmp_O(ipoint) * tmp_S(ipoint) &
|
||||
- 2.d0 * ( tmp_J(ipoint,1) * tmp_M(ipoint,1) &
|
||||
+ tmp_J(ipoint,2) * tmp_M(ipoint,2) &
|
||||
+ tmp_J(ipoint,3) * tmp_M(ipoint,3)))
|
||||
enddo
|
||||
|
||||
diag_three_elem_hf = diag_three_elem_hf - 2.d0 * (sum(tmp))
|
||||
|
||||
deallocate(tmp)
|
||||
|
||||
endif ! alpha/beta condition
|
||||
|
||||
endif ! three_body_h_tc
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user