10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-28 16:12:40 +02:00

Vectorized int2_u2_j1b2

This commit is contained in:
Anthony Scemama 2022-11-20 23:18:16 +01:00
parent 49cc53e919
commit 80b01d5947
2 changed files with 36 additions and 45 deletions

View File

@ -368,3 +368,5 @@ subroutine overlap_gauss_r12_ao_with1s_v(B_center, beta, D_center, delta, i, j,
end

View File

@ -56,11 +56,13 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n
expo_fit = expo_gauss_1_erf_x_2(i_fit)
coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) * coef
call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, expo_fit, i, j, int_fit_v, n_points_final_grid)
call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, &
expo_fit, i, j, int_fit_v, n_points_final_grid)
do ipoint = 1, n_points_final_grid
int2_grad1u2_grad2u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint)
enddo
enddo
enddo
@ -105,22 +107,21 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final
provide mu_erf final_grid_points_transp j1b_pen
call wall_time(wall0)
int2_u2_j1b2 = 0.d0
int2_u2_j1b2(:,:,:) = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,&
!$OMP coef_fit, expo_fit, int_fit_v, tmp) &
!$OMP coef_fit, expo_fit, int_fit_v) &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size,&
!$OMP final_grid_points_transp, n_max_fit_slat, &
!$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_u2_j1b2)
allocate(int_fit_v(n_points_final_grid))
!$OMP DO
!$OMP DO SCHEDULE(dynamic)
do i = 1, ao_num
do j = i, ao_num
tmp = 0.d0
do i_1s = 1, List_all_comb_b3_size
coef = List_all_comb_b3_coef (i_1s)
@ -134,22 +135,18 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final
expo_fit = expo_gauss_j_mu_x_2(i_fit)
coef_fit = coef_gauss_j_mu_x_2(i_fit) * coef
do ipoint = 1, n_points_final_grid
r(1) = final_grid_points_transp(ipoint,1)
r(2) = final_grid_points_transp(ipoint,2)
r(3) = final_grid_points_transp(ipoint,3)
int_fit_v(ipoint) = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
enddo
call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, &
expo_fit, i, j, int_fit_v, n_points_final_grid)
do ipoint = 1, n_points_final_grid
int2_u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint)
enddo
enddo
enddo
enddo
enddo
enddo
!$OMP END DO
deallocate(int_fit_v)
!$OMP END PARALLEL
@ -185,10 +182,10 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (3, ao_num, ao_num, n_p
double precision :: tmp_x, tmp_y, tmp_z
double precision :: wall0, wall1
provide mu_erf final_grid_points j1b_pen
provide mu_erf final_grid_points_transp j1b_pen
call wall_time(wall0)
int2_u_grad1u_x_j1b2 = 0.d0
int2_u_grad1u_x_j1b2(:,:,:,:) = 0.d0
!$OMP PARALLEL DEFAULT (NONE) &
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
@ -196,22 +193,19 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (3, ao_num, ao_num, n_p
!$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, &
!$OMP tmp_x, tmp_y, tmp_z) &
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, &
!$OMP final_grid_points, n_max_fit_slat, &
!$OMP final_grid_points_transp, n_max_fit_slat, &
!$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, &
!$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, &
!$OMP List_all_comb_b3_cent, int2_u_grad1u_x_j1b2)
!$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)
r(1) = final_grid_points_transp(ipoint,1)
r(2) = final_grid_points_transp(ipoint,2)
r(3) = final_grid_points_transp(ipoint,3)
do i = 1, ao_num
do j = i, ao_num
tmp_x = 0.d0
tmp_y = 0.d0
tmp_z = 0.d0
do i_1s = 1, List_all_comb_b3_size
coef = List_all_comb_b3_coef (i_1s)
@ -236,21 +230,16 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (3, ao_num, ao_num, n_p
centr_1s(3) = alpha_1s_inv * (beta * B_center(3) + expo_fit * r(3))
expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist
!if(expo_coef_1s .gt. 80.d0) cycle
coef_tmp = coef * coef_fit * dexp(-expo_coef_1s)
!if(dabs(coef_tmp) .lt. 1d-10) cycle
call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit)
tmp_x += coef_tmp * int_fit(1)
tmp_y += coef_tmp * int_fit(2)
tmp_z += coef_tmp * int_fit(3)
int2_u_grad1u_x_j1b2(1,j,i,ipoint) += coef_tmp * int_fit(1)
int2_u_grad1u_x_j1b2(2,j,i,ipoint) += coef_tmp * int_fit(2)
int2_u_grad1u_x_j1b2(3,j,i,ipoint) += coef_tmp * int_fit(3)
enddo
enddo
int2_u_grad1u_x_j1b2(1,j,i,ipoint) = tmp_x
int2_u_grad1u_x_j1b2(2,j,i,ipoint) = tmp_y
int2_u_grad1u_x_j1b2(3,j,i,ipoint) = tmp_z
enddo
enddo
enddo